Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- program ScaRPG_Map_Editor;
- {
- ScaRPG Map Editor
- A tool that allows anyone to create an intricate map
- Author for used procedures and functions is 'mixster' unless otherwise stated
- Extremely heavy commenting required. If distributed without, kill whoever did it
- Designed primarily for adaptation. If you don't like it, change it - that's why heavy commenting required
- }
- type
- TSheet = record // Record of information on a sheet e.g. tilesheet; spritesheet.
- b: Integer; // Bitmap holder for the sheet
- h: Integer; // Height in tiles of sheet
- w: Integer; // Width in tiles of sheet
- c: TCanvas; // Holds the canvas for the bitmap 'b'
- end;
- TMap = record //Record of information for the entire map
- 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
- attribs: T2DIntArray; // layer that holds attributes for a tile
- width, height, depth, sprite: Integer; // Width, height and depth for dimensions; sprite is layer where sprites are drawn on top of
- vis: TIntegerArray; // Holds bitmap for visible layers
- mC: TPoint; // Holds the top left position so we know which bits to draw
- saved: Boolean; // Holds whether or not the map is currently saved
- fp: string; // Holds filepath of where it is currently saved
- fn: string; // Holds filename of map
- end;
- var
- maps: array of TMap; // Holds the currently open maps
- curMap: Integer; // Holds the index of currently visible map
- curLay: Integer; // Holds the layer that everything is drawn onto
- bitDeb: string; // Holds the string that has the info about all the bitmaps currently in use
- bitLoc: TStringArray; // Holds the location from where the relating bitmap was created
- drawSize: TPoint; // Holds the number of tiles to draw in regards to .x = width .y = height
- shTile: TSheet; // See TSheet. shTile for tilesheet
- drawTiles: T2DPointArray; // Holds the tiles in a box shape of which to draw
- drawArea: TPoint; // Holds the position where the mouse was pressed down on the map
- mode: TPoint; // Holds which method of altering and in what way
- selTiles: TPointArray; // Holds the tiles that are selected when in mode x2
- fMain: TForm; // Main form for editing or creating a map
- iMain: TImage; // Main visible component for displaying the map
- mMain: TMainMenu; // Main menu holder thingy
- mFile: TMenuItem; // Menu that holds file relating stuff
- mFileOpts: array of TMenuItem; // Run of the mill menu options stored in an array
- menuNames: TStringArray; // Holds the names for the options in the mFileOpts array
- pSheet: TPanel; // Holds all the tilesheet relating stuff
- iSheet: TImage; // Visible component for displaying the tilesheet
- pTile: TPanel; // Panel to hold the currently selected tile(s) and similar stuff
- iTile: TImage; // Visible component for displaying currently selected tile
- bTools: array of TButton; // Buttons that switch to different map tools
- toolHints: TStringArray; // Holds the hints for the buttons
- tcMain: TTabControl; // Main tab bit for holding the maps
- sbHorz, sbVert: TScrollBar; // Main scrollbars for scrolling map movement
- sbSheet: TScrollBox; // Scrollbox that the tilesheet goes into
- bLayUp, bLayDo: TButton; // Change the layer that is currently being overwritten
- lCurLay: TLabel; // Holds the visual display of currently select layer
- ppMain: TPopupMenu; // The main popup menu for when right clicking on the map - handles size adjustment
- pmMain: array of TMenuItem; // Holds the main menu items for the popup
- pmSub: array of array of TMenuItem; // Holds the submenu items for the the popup
- pmOpts: array of array of array of TMenuItem; // Holds the popup menu options for adjusting map size
- procedure Crash(str: string); // Simple procedure to allow the script to crash easily from a single line due to laziness
- begin
- Writeln('Crashing: ' + str); // Print the crashing reason
- TerminateScript; // Stop the script running
- end;
- function MBitmap(w, h: Integer; str, from: string): Integer; // Creation half of the memory leak debugging
- begin
- Result := BitmapFromString(w, h, str); // Start by actually making the bitmap since we need the reference number
- while (Length(bitDeb) < Result + 1) do // While the string is too short
- bitDeb := bitDeb + '2'; // Increase the length of the string by adding a 2 which signifies bitmap created by alternate means
- bitDeb[Result + 1] := '1'; // Set the index to 1 to signify in use - string's start at 1 not 0, hence the + 1
- SetLength(bitLoc, Length(bitDeb) + 1); // This is 1 longer than the string due to it starting on 0 and me wanting them in line
- bitLoc[Result + 1] := from; // Set where the bitmap was created from
- end;
- procedure MFreeBitmap(b: Integer); // Destroying half of the memory leak debugging
- begin
- FreeBitmap(b); // Start by freeing it as the reference remains afterwards
- b := b + 1 // Increment it to line it up with the arrays
- if (b > Length(bitDeb)) then // If the debug string is too short
- exit; // Then we don't need to change anything (created by LoadBitmap or something similar) so exit procedure
- bitDeb[b] := '0'; // Set to 0 to signify not in use
- bitLoc[b] := ''; // Set to blank
- end;
- procedure LoadSheet(var sheet: TSheet; filename: string); // Loads a sheet from a file
- var
- s: TPoint;
- begin
- sheet.b := LoadBitmap(filename); // Load the bitmap
- GetBitmapSize(sheet.b, s.x, s.y); // Get actual dimensions
- sheet.w := s.x div 32; // Convert to tile dimenions
- sheet.h := s.y div 32; // As above
- sheet.c := GetBitmapCanvas(sheet.b); // Get the canvas for the bitmap
- end;
- procedure ConvertTile(var p: TPoint; i: Integer); // Changes integer based reference to an actual position
- begin
- p.x := (i mod shTile.w) * 32; // mod by width to get the .x then * 32 to get actual location
- p.y := (i div shTile.w) * 32; // div by width to get the .y then same as above
- end;
- function ConvertBack(p: TPoint): Integer; // Change actual location back to integer reference
- begin
- 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
- end;
- procedure FreeVisibleMap(tempMap: TMap); // Frees all the drawing bitmaps
- var
- z: Integer;
- begin
- for z := 0 to tempMap.depth - 1 do // Loop through all the layers
- MFreeBitmap(tempMap.vis[z]); // and free the bitmap used for drawing
- end;
- procedure CreateVisibleMap(var tempMap: TMap);
- var
- z: Integer;
- begin
- SetLength(tempMap.vis, tempMap.depth);
- for z := 0 to tempMap.depth - 1 do
- tempMap.vis[z] := MBitmap(drawSize.x * 32, drawSize.y * 32, '', 'CreateVisibleMap');
- end;
- procedure GenerateBlankMap(var map: TMap; w, h, d: Integer);
- var
- z, y, x: Integer;
- begin
- map.depth := d;
- map.height := h;
- map.width := w;
- map.sprite := Round(h / 1.5);
- map.mC := Point(0, 0);
- map.fp := ScriptPath;
- map.saved := true;
- SetLength(map.layers, d);
- SetLength(map.vis, d);
- for z := 0 to d - 1 do
- begin
- SetLength(map.layers[z], h);
- if (z = 0) then
- SetLength(map.attribs, h);
- for y := 0 to h - 1 do
- begin
- SetLength(map.layers[z][y], w);
- if (z = 0) then
- SetLength(map.attribs[y], w);
- for x := 0 to w - 1 do
- begin
- map.layers[z][y][x] := Point(-1, 0);
- if (z = 0) then
- map.attribs[y][x] := 0;
- end;
- end;
- end;
- CreateVisibleMap(map);
- end;
- procedure PaintMap; // Paints the layers on to the form so we can see the map
- var
- t, i: Integer;
- begin
- t := MBitmap(480, 480, '', 'PaintMap'); // Create temp bitmap
- FastDrawClear(t, 16448505); // Ensure temp bitmap is blank
- for i := 0 to maps[curMap].depth - 1 do // Loop through all layers
- begin
- SetTransparentColor(maps[curMap].vis[i], 16448505); // Set transparent colour so the layers work nicely
- FastDrawTransparent(0, 0, maps[curMap].vis[i], t); // Draw sprite layer on with transparency so bottom layer is visible
- end;
- SafeDrawBitmap(t, iMain.Canvas, 0, 0); // Draw the map onto the visual component
- MFreeBitmap(t); // Free our temp bitmap
- end;
- procedure RedrawMap(tempMap: TMap); // Draw the map entirely from scratch - can be very confusing to understand, but straight forward enough
- var
- z, y, x, t, d, blankTile: Integer;
- p: TPoint;
- ts, ds: TCanvas;
- begin
- t := MBitmap(drawSize.x * 32, drawSize.y * 32, '', 'RedrawMap'); // Create temp bitmap
- ts := shTile.c; // Get the tilesheet's canvas
- ds := GetBitmapCanvas(t); // Get the temp bitmap's canvas
- blankTile := MBitmap(32, 32, '', 'RedrawArea');
- FastDrawClear(blankTile, clBlack);
- for z := 0 to tempMap.depth - 1 do // Loop through all the layers
- begin
- FastDrawClear(tempMap.vis[z], clBlack); // Ensure layer is clear
- d := tempMap.vis[z]; // Set d to current layer
- FastDrawClear(t, clBlack); // Clear the temp bitmap
- p.y := -32; // Holds where to draw on the visible map - reset it here
- for y := tempMap.mC.y to tempMap.mC.y + drawSize.y do // Loop through all on screen vertical tiles
- begin
- p.y := p.y + 32; // Increment the position by the height of a tile (32)
- if (y >= tempMap.height) then // If y is off the bottom of the map
- break; // It won't go back on, so break the loop
- p.x := -32; // Holds where to draw on the visible map - reset it here
- for x := tempMap.mC.x to tempMap.mC.x + drawSize.x do // Loop through all on screen horizontal tiles
- begin
- p.x := p.x + 32; // Increment the position by the width of a tile
- if (x >= tempMap.width) then // If x is off the right of the map
- break; // It won't go back on, so break the loop
- if (tempMap.layers[z][y][x].x <> -1) then
- SafeCopyCanvas(ts, ds, tempMap.layers[z][y][x].x, tempMap.layers[z][y][x].y, tempMap.layers[z][y][x].x + 32, tempMap.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
- else
- SafeDrawBitmap(blankTile, ds, p.x, p.y);
- end;
- end;
- FastDrawTransparent(0, 0, t, d); // Draw the layer without transparency onto appropriate bitmap
- end;
- MFreeBitmap(t); // Free our temp bitmap
- MFreeBitmap(blankTile);
- end;
- procedure RepaintArea(ts, te, dp: TPoint);
- var
- t, p, z, w, h: Integer;
- tempMap: TMap;
- begin
- tempMap := maps[curMap];
- w := ((te.x + 1) - ts.x) * 32; // Get the width to draw by getting the difference in start and end then multiplying by tile width
- h := ((te.y + 1) - ts.y) * 32; // As above, only height
- t := MBitmap(w, h, '', 'RepaintArea');
- p := MBitmap(w, h, '', 'RepaintArea');
- FastDrawClear(p, clBlack);
- for z := 0 to tempMap.depth - 1 do
- begin
- SafeCopyCanvas(GetBitmapCanvas(tempMap.vis[z]), GetBitmapCanvas(t), dp.x, dp.y, dp.x + w, dp.y + h, 0, 0, w, h);
- SetTransparentColor(t, 16448505); // Set transparent colour so the layers work nicely
- FastDrawTransparent(0, 0, t, p);
- FastDrawClear(t, 16448505);
- end;
- MFreeBitmap(t);
- SafeDrawBitmap(p, iMain.Canvas, dp.x, dp.y); // Draw the map onto the visual component
- MFreeBitmap(p);
- end;
- 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
- var
- t, d, z, y, x, w, h, blankTile: Integer;
- tc, tsc: TCanvas;
- p: TPoint;
- tempMap: TMap;
- begin
- tempMap := maps[curMap];
- w := (te.x - ts.x) * 32; // Get the width to draw by getting the difference in start and end then multiplying by tile width
- h := (te.y - ts.y) * 32; // As above, only height
- t := MBitmap(w + 32, h + 32, '', 'RedrawArea'); // Setup the bitmap used to draw the new stuff
- tsc := shTile.c; // Get the tilesheet's canvas
- tc := GetBitmapCanvas(t); // Get the temp bitmap's canvas
- blankTile := MBitmap(32, 32, '', 'RedrawArea');
- FastDrawClear(blankTile, clBlack);
- if (ts.y < 0) then
- ts.y := 0;
- if (te.y >= tempMap.height) then
- te.y := tempMap.height - 1;
- if (ts.x < 0) then
- ts.x := 0;
- if (te.x >= tempMap.width) then
- te.x := tempMap.width - 1;
- for z := 0 to tempMap.depth - 1 do // Loop through all layers
- begin
- d := tempMap.vis[z];
- FastDrawClear(t, clBlack); // Clear temp bitmap
- p.y := -32; // Reset p.y
- for y := ts.y to te.y do
- begin
- p.y := p.y + 32; // Increment position to draw to
- p.x := -32;
- for x := ts.x to te.x do // Loop through all columns
- begin
- p.x := p.x + 32; // Increment position to draw to
- if (tempMap.layers[z][y][x].x <> -1) then
- SafeCopyCanvas(tsc, tc, tempMap.layers[z][y][x].x, tempMap.layers[z][y][x].y, tempMap.layers[z][y][x].x + 32, tempMap.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
- else
- SafeDrawBitmap(blankTile, tc, p.x, p.y);
- end;
- end;
- FastDrawTransparent(dp.x, dp.y, t, d); // Draw the layer onto appropriate bitmap without transparency for this bit
- end;
- MFreeBitmap(t); // Free our temp bitmap
- MFreeBitmap(blankTile);
- RepaintArea(ts, te, dp);
- end;
- procedure HandleMovement(amount: Integer; dir: Integer); // Wrapper procedure for RedrawArea
- var
- t, z: Integer;
- tc: TCanvas;
- s, e, o, d: TPoint;
- begin
- if (amount < 0) then
- amount := - amount;
- if (not (InRange(dir, 1, 4))) then
- begin
- Writeln('Invalid dir passed to HandleMovement');
- exit;
- end;
- t := MBitmap((drawSize.x + 1) * 32, (drawSize.y + 1) * 32, '', 'HandleMovement');
- tc := GetBitmapCanvas(t);
- SafeCopyCanvas(iMain.Canvas, tc, 0, 0, iMain.Width, iMain.Height, 0, 0, iMain.Width, iMain.Height);
- s := maps[curMap].mC;
- e := Point(s.x + drawSize.x, s.y + drawSize.y);
- o := Point(0, 0);
- d := Point(0, 0);
- case dir of
- 1: begin
- e.y := s.y + amount;
- o.y := amount * 32;
- end;
- 2: begin
- e.x := s.x + amount;
- o.x := amount * 32;
- end;
- 3: begin
- s.y := e.y - amount;
- o.y := - (amount * 32);
- d.y := (drawSize.y - amount) * 32;
- end;
- 4: begin
- s.x := e.x - amount;
- o.x := - (amount * 32);
- d.x := (drawSize.x - amount) * 32;
- end;
- end;
- SafeDrawBitmap(t, iMain.Canvas, o.x, o.y);
- FastDrawClear(t, clBlack);
- for z := 0 to maps[curMap].depth - 1 do
- begin
- SafeDrawBitmap(maps[curMap].vis[z], tc, 0, 0);
- SafeDrawBitmap(t, GetBitmapCanvas(maps[curMap].vis[z]), o.x, o.y);
- end;
- MFreeBitmap(t);
- RedrawArea(s, e, d);
- end;
- procedure AddMap(w, h, d: Integer); // Handles the setting up of a new map
- var
- l: Integer;
- begin
- l := Length(maps); // Get the length of the array
- SetLength(maps, l + 1); // Increase the length of the array by 1 for the new map
- GenerateBlankMap(maps[l], w, h, d); // See 'GenerateBlankMap'
- tcMain.Tabs.Append('Untitled'); // Add a new tab to access it
- tcMain.TabIndex := tcMain.Tabs.Count - 1; // Switch to the new tab
- curMap := l; // Update curMap as well so that drawing isn't done to random maps
- maps[curMap].fp := ScriptPath;
- maps[curMap].fn := 'Untitled';
- curLay := d - 1; // Set the drawing layer to the top layer by default
- lCurLay.Caption := 'Layer ' + IntToStr(curLay) + ' selected'; // Update the layer caption so we know where we are at
- sbHorz.Max := maps[curMap].Width - drawSize.x;
- sbVert.Max := maps[curMap].Height - drawSize.y;
- end;
- procedure NewMap;
- begin
- AddMap(25, 25, 3);
- RedrawMap(maps[curMap]);
- PaintMap;
- end;
- procedure SetMapInfo(index: Integer; fpstr: string);
- begin
- maps[index].saved := True; // Toggle saved to true to show that it has been saved and not modified
- maps[index].fp := ExtractFilePath(fpstr); // Update the filepath to the map
- maps[index].fn := ExtractFileName(fpstr); // Update the filename of the map
- maps[index].fn := Copy(maps[index].fn, 1, LastPos('.', maps[curMap].fn) - 1); // And remove the file extension
- tcMain.Tabs[index] := maps[index].fn; // Update the tab to show the filename minus extension
- end;
- procedure MapImplode(var arr: TStringArray; var tempMap: TMap); // Breaks down the map into an array to be used for saving maps
- var
- z, y, x, i: Integer;
- begin
- SetLength(arr, 0); // Ensure array passed is empty
- if ((tempMap.depth <= 0) or (tempMap.height <= 0) or (tempMap.width <= 0)) then // If map is blank/invalid size
- Crash('Imploding map of invalid dimensions (one is set to zero)'); // Crash
- i := 2 + (((tempMap.depth + 1) * (tempMap.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 and 1 as added to depth for the attributes layer
- SetLength(arr, i); // Set the length so it's the right length for the data
- arr[0] := IntToStr(tempMap.width) + ',' + IntToStr(tempMap.height) + ',' + IntToStr(tempMap.depth); // Set first array index to hold dimenions info (x by y by z)
- for x := 1 to i - 1 do // Loop through all arrays
- arr[x] := ''; // Set to blank to ensure no corruption
- 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
- for z := 0 to tempMap.depth do // Loop through all layers and the attributes
- begin
- for y := 0 to tempMap.height - 1 do // Loop through all rows
- begin
- i := i + 1; // Increment i so it points to next blank array
- for x := 0 to tempMap.width - 1 do // Loop through all columns
- if (z < tempMap.depth) then // if it is a visual layer
- arr[i] := arr[i] + IntToStr(ConvertBack(tempMap.layers[z][y][x])) + ',' // Append the converted tile and a comma to the end of the array
- else // if it is the attirbutes layer
- arr[i] := arr[i] + IntToStr(tempMap.attribs[y][x]) + ','; // Append the attribute and a comma to the end of the array
- Delete(arr[i], Length(arr[i]), 1); // Remove the trailing comma
- end;
- i := i + 1; // Increment i to give the blank line between "paragraphs"
- end;
- end;
- procedure SaveMap(filename: string); // Outputs the map to a file
- var
- f, i: Integer;
- s: TStringArray;
- begin
- f := RewriteFile(filename, False); // Open file and wipe it or create the file then assign to f
- MapImplode(s, maps[curMap]); // See MapImplode
- for i := 0 to High(s) do // Loop through s
- WriteFileString(f, s[i] + #13 + #10); // Write to file with new line after
- CloseFile(f); // Close the file
- end;
- procedure ExportMap; // GUI method of saving a map by opening a TSaveDialog
- var
- dialog: TSaveDialog;
- begin
- dialog := TSaveDialog.Create(nil); // Create parentless save dialog
- dialog.Filter := 'ScaRPG map|*.srpg'; // Set filter to only allow the the extension specified
- dialog.InitialDir := maps[curMap].fp; // Set starting directory to same as where script is saved if not saved, else to same place if previously saved
- if (not dialog.Execute) then // If no file is specified after opening the dialog and it is closed
- exit; // exit procedure
- SaveMap(dialog.filename); // See SaveMap - the chosen file is passed as where to save it to
- SetMapInfo(curMap, dialog.filename);
- end;
- procedure MExplode(var arr: TStringArray; str, del: string); // Standard Explode procedure written for older Scar versions
- var
- i, h, l: Integer;
- begin
- SetLength(arr, 0); // Ensure passed array is blank
- h := -1; // Set high of array to -1
- l := Length(del) - 1; // Amount to delete by based on del's length to ensure it is removed if longer than 1 char
- while (true) do // Endless loop
- begin
- h := h + 1; // Increment h
- SetLength(arr, h + 1); // Make array longer by one
- i := Pos(del, str); // Find first occurence of del in str
- if (i = 0) then // If it is not found
- break; // Break from loop
- arr[h] := Copy(str, 1, i - 1); // Copy the text until del (not including del) to the array
- Delete(str, 1, i + l); // Remove copied text as well as del
- end;
- 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
- end;
- function StrInt(s: string): Integer; // "Safe" version of IntToStr to catch dodgy map files specifically
- begin
- try
- Result := StrToInt(s); // Try standard conversion
- except // If it is non-numeric
- if (s = '') then // If it is blank
- Result := 0 // Set to 0
- else // If non-numeric and not blank
- Crash('StrInt passed invalid string - "' + s + '"'); // Crash
- end;
- end;
- procedure MapExplode(var tempMap: TMap; str: string); // Creates the backend for the visual map from a string
- var
- lineArr: TStringArray;
- mapArr: array of TStringArray;
- i, z, y, x: Integer;
- begin
- if (Pos(#13 + #10, str) = 0) then // If no enter's are found in the string
- Crash('Exploding map from an invalid input string'); // Crash
- MExplode(lineArr, str, #13 + #10); // See MExplode - breaks into seperate lines
- SetLength(mapArr, Length(lineArr)); // Set 2D array to the same length as the number of lines
- for i := 0 to High(lineArr) do // Loop through all the lines
- MExplode(mapArr[i], lineArr[i], ','); //See MExplode - breaks into seperate values between the comma's
- tempMap.width := StrInt(mapArr[0][0]); // Set the dimension of the map based on the extracted values
- tempMap.height := StrInt(mapArr[0][1]); // As above
- tempMap.depth := StrInt(mapArr[0][2]); // As above
- i := 2; // Set i to 2 - the first array relating to the map
- // This section is like the inverse of the main loop in MapImplode
- SetLength(tempMap.layers, tempMap.depth); // Set the 3D TPoint array to length of the depth
- for z := 0 to tempMap.depth - 1 do // Loop through all layers and the attribute layer
- begin
- SetLength(tempMap.layers[z], tempMap.height); // Set a 2D TPoint array to length of the height
- for y := 0 to tempMap.height - 1 do // Loop through all rows
- begin
- SetLength(tempMap.layers[z][y], tempMap.width); // Set the TPoint array to the length of the width
- for x := 0 to tempMap.width - 1 do // Loop through all columns
- ConvertTile(tempMap.layers[z][y][x], StrInt(mapArr[i][x])); // See ConvertTile - this is done so that map painting requires less calculations
- i := i + 1; // Go onto the next line of the loaded "paragraph"
- end;
- i := i + 1; // Would be a blank line here, so go on to the next
- end;
- SetLength(tempMap.attribs, tempMap.height); // Set the height of the 2DIntArray
- for y := 0 to tempMap.height - 1 do // Loop through all rows
- begin
- SetLength(tempMap.attribs[y], tempMap.width); // Set the width of the TIntegerArray
- for x := 0 to tempMap.width - 1 do // Loop through all columns
- tempMap.attribs[y][x] := StrInt(mapArr[i][x]); // Convert the string into an integer attribute value
- i := i + 1;
- end;
- end;
- procedure LoadMap(filename: string); // Handles the loading of a map file and doing what needs to be done
- var
- f: Integer;
- s: string;
- begin
- if (not FileExists(filename)) then // If file does not exist
- Crash('File specified to load does not exist - "' + filename + '"'); // Crash
- f := OpenFile(filename, False); // Open the file specified
- ReadFileString(f, s, FileSize(f)); // Read the contents of the file
- CloseFile(f); // Close the file
- MapExplode(maps[curMap], s); // See MapExplode - pass the file contents to break apart
- end;
- procedure ImportMap; // GUI method of opening a map by opening a TOpemDialog
- var
- dialog: TOpenDialog;
- begin
- dialog := TOpenDialog.Create(nil); // Create a parentless open dialog
- dialog.Filter := 'ScaRPG map|*.srpg'; // Set the filter to only show map files
- if (ScriptPath <> '') then // If the script is saved
- dialog.InitialDir := ScriptPath; // Set the starting directory to the place where the script is saved in
- if (not dialog.Execute) then // If the dialog is launched and no file is selected when closed
- exit; // exit procedure
- if (not maps[curMap].saved) then // If map isn't saved
- AddMap(1, 1, 1); // Then open a new tab instead
- FreeVisibleMap(maps[curMap]); // Need to "refresh" the visible bitmap holders
- LoadMap(dialog.filename); // See LoadMap - passing the selected file as the one to load
- CreateVisibleMap(maps[curMap]); // Set up the visible layers
- SetMapInfo(curMap, dialog.filename);
- RedrawMap(maps[curMap]); // Redraw the map as it is unconstructed
- PaintMap; // Then paint it onto the form
- end;
- procedure CloseMap(var index: Integer);
- var
- i: Integer;
- begin
- FreeVisibleMap(maps[index]);
- if (index < High(maps)) then
- begin
- for i := index to High(maps) - 1 do
- Swap(maps[i], maps[i + 1]);
- end
- else if (index = 0) then
- begin
- AddMap(25, 25, 3);
- curMap := 0;
- Swap(maps[0], maps[1]);
- RedrawMap(maps[0]);
- end;
- SetLength(maps, High(maps));
- tcMain.Tabs.Delete(index);
- if (index > High(maps)) then
- index := index - 1;
- PaintMap;
- end;
- procedure PaintDrawTiles;
- var
- t, w, h, x, y: Integer;
- r: Extended;
- begin
- h := High(drawTiles);
- if (h >= 0) then
- w := High(drawTiles[0])
- else
- w := -1;
- t := MBitmap(64, 64, '', 'PaintDrawTiles');
- FastDrawClear(t, clBlack);
- SafeDrawBitmap(t, iTile.Canvas, 0, 0);
- MFreeBitmap(t);
- if (w = -1) then
- iTile.Canvas.TextOut(16, 8, 'None')
- else
- begin
- r := 64.0 / (Max(w, h) + 1);
- for y := 0 to h do
- for x := 0 to w do
- if (drawTiles[y][x].x > -1) then
- SafeCopyCanvas(shTile.c, iTile.Canvas, drawTiles[y][x].x, drawTiles[y][x].y, drawTiles[y][x].x + 32, drawTiles[y][x].y + 32, Round(x * r), Round(y * r), Round((x + 1) * r), Round((y + 1) * r));
- end;
- end;
- procedure MaskTile(dp: TPoint);
- begin
- iMain.Canvas.Pen.Color := clRed;
- iMain.Canvas.Brush.Style := bsFrame;
- iMain.Canvas.Rectangle(dp.x + 1, dp.y + 1, dp.x + 31, dp.y + 31);
- end;
- procedure MaskSelectedTiles;
- var
- i, h: Integer;
- p: TPoint;
- ar: TBox;
- begin
- h := Length(selTiles) - 1;
- if (h = -1) then
- exit;
- ar := IntToBox(maps[curMap].mC.x, maps[curMap].mC.y, maps[curMap].mC.x + drawSize.x, maps[curMap].mC.y + drawSize.y);
- for i := 0 to h do
- try
- if (PointInBox(selTiles[i], ar)) then
- begin
- p := Point((selTiles[i].x - maps[curMap].mC.x) * 32, (selTiles[i].y - maps[curMap].mC.y) * 32);
- MaskTile(p);
- end;
- except
- Writeln(IntToStr(i) + ' of ' + IntToStr(h));
- end;
- end;
- procedure OnMapMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- if ((mode.y = 0) or (mode.y = 1) or (mode.y = 4)) then
- exit;
- X := Trunc(X / 32.0);
- Y := Trunc(Y / 32.0);
- drawArea := Point(X, Y);
- end;
- procedure OnMapMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- var
- d, t, r: TPoint;
- a, b, w, h: Integer;
- s: Boolean;
- sT: T2DPointArray;
- begin
- if (mbRight = Button) then
- begin
- X := Trunc(X / 32.0);
- Y := Trunc(Y / 32.0);
- drawArea := Point(maps[curMap].mC.x + X, maps[curMap].mC.y + Y);
- GetMousePos(X, Y);
- ppMain.Popup(X, Y);
- exit;
- end;
- if ((mode.y = 1) or (mode.y = 4)) then
- exit;
- if (mode.x = 0) then
- begin
- if (Length(drawTiles) = 0) then
- exit
- else if (Length(drawTiles[0]) = 0) then
- exit;
- end;
- if (mode.y <> 0) then
- begin
- X := Trunc(X / 32.0);
- Y := Trunc(Y / 32.0);
- if (X >= maps[curMap].width) then
- X := maps[curMap].width - 1
- else if (X < 0) then
- X := 0;
- if (Y >= maps[curMap].height) then
- Y := maps[curMap].height - 1
- else if (Y < 0) then
- Y := 0;
- d := Point(X, Y);
- if (d.x < drawArea.x) then
- Swap(d.x, drawArea.x);
- if (d.y < drawArea.y) then
- Swap(d.y, drawArea.y);
- X := maps[curMap].mC.x + drawArea.x;
- Y := maps[curMap].mC.y + drawArea.y;
- t := Point(d.x - drawArea.x, d.y - drawArea.y);
- end
- else
- begin
- drawArea := Point(0, 0);
- d := Point(maps[curMap].width - 1, maps[curMap].height - 1);
- t := d;
- X := 0;
- Y := 0;
- end;
- s := False;
- if ((mode.x = 0) and (mode.y = 3)) then
- begin
- h := Length(drawTiles);
- if (h <> 0) then
- w := Length(drawTiles[0])
- else
- w := 0;
- if ((h < 3) or (w < 3) or (t.y < 3) or (t.x < 3)) then
- begin
- s := True;
- mode.y := 2;
- end
- else
- begin
- h := h - 1;
- w := w - 1;
- SetLength(sT, h - 1);
- for a := 0 to h - 2 do
- begin
- SetLength(sT[a], w - 1);
- for b := 0 to w - 2 do
- sT[a][b] := drawTiles[(a mod (h - 1)) + 1][(b mod (w - 1)) + 1];
- end;
- if (drawTiles[0][0].x <> -2) then
- maps[curMap].layers[curLay][Y][X] := drawTiles[0][0];
- if (drawTiles[h][0].x <> -2) then
- maps[curMap].layers[curLay][Y + t.y][X] := drawTiles[h][0];
- if (drawTiles[0][w].x <> -2) then
- maps[curMap].layers[curLay][Y][X + t.x] := drawTiles[0][w];
- if (drawTiles[h][w].x <> -2) then
- maps[curMap].layers[curLay][Y + t.y][X + t.x] := drawTiles[h][w];
- for a := 1 to t.y - 1 do
- begin
- if (drawTiles[((a - 1) mod (h - 1)) + 1][0].x <> -2) then
- maps[curMap].layers[curLay][Y + a][X] := drawTiles[((a - 1) mod (h - 1)) + 1][0];
- if (drawTiles[((a - 1) mod (h - 1)) + 1][w].x <> -2) then
- maps[curMap].layers[curLay][Y + a][X + t.x] := drawTiles[((a - 1) mod (h - 1)) + 1][w];
- end;
- for b := 1 to t.x - 1 do
- begin
- if (drawTiles[0][((b - 1) mod (w - 1)) + 1].x <> -2) then
- maps[curMap].layers[curLay][Y][X + b] := drawTiles[0][((b - 1) mod (w - 1)) + 1];
- if (drawTiles[h][((b - 1) mod (w - 1)) + 1].x <> -2) then
- maps[curMap].layers[curLay][Y + t.y][X + b] := drawTiles[h][((b - 1) mod (w - 1)) + 1];
- end;
- for a := 1 to t.y - 1 do
- for b := 1 to t.x - 1 do
- if (sT[(a - 1) mod Length(sT)][(b - 1) mod Length(sT[0])].x <> -2) then
- maps[curMap].layers[curLay][Y + a][X + b] := sT[(a - 1) mod Length(sT)][(b - 1) mod Length(sT[0])];
- end;
- end;
- if ((mode.x = 0) and ((mode.y = 0) or (mode.y = 2))) then
- begin
- for a := 0 to t.y do
- for b := 0 to t.x do
- if (drawTiles[a mod Length(drawTiles)][b mod Length(drawTiles[0])].x <> -2) then
- maps[curMap].layers[curLay][Y + a][X + b] := drawTiles[a mod Length(drawTiles)][b mod Length(drawTiles[0])];
- end;
- if (mode.x = 2) then
- begin
- SetLength(selTiles, (t.x + 1) * (t.y + 1));
- w := -1;
- for a := 0 to t.y do
- for b := 0 to t.x do
- begin
- w := w + 1;
- selTiles[w] := Point(X + b,Y + a);
- end;
- Writeln(IntToStr(X) + ',' + IntToStr(Y) + ' - ' + IntToStr(X + t.x) + ',' + IntToStr(Y + t.y));
- end;
- if (mode.x = 1) then
- begin
- for a := 0 to t.y do
- for b := 0 to t.x do
- maps[curMap].layers[curLay][Y + a][X + b] := Point(-1, 0);
- end;
- if (s) then
- mode.y := 3;
- r := Point(drawArea.x * 32, drawArea.y * 32);
- if (mode.y <> 0) then
- RedrawArea(Point(X, Y), Point(X + t.x, Y + t.y), r)
- else
- begin
- RedrawMap(maps[curMap]);
- PaintMap;
- end;
- if (mode.x = 2) then
- MaskSelectedTiles;
- end;
- procedure OnMapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
- var
- dp: TPoint;
- h, i: Integer;
- begin
- if (mode.y <> 1) then
- exit;
- if (not (ssLeft in Shift)) then
- exit;
- if (mode.x = 0) then
- begin
- if (Length(drawTiles) = 0) then
- exit
- else if (Length(drawTiles[0]) = 0) then
- exit;
- end;
- dp := Point(Trunc(X / 32.0), Trunc(Y / 32.0));
- X := dp.x + maps[curMap].mC.x;
- Y := dp.y + maps[curMap].mC.y;
- dp := Point(dp.x * 32, dp.y * 32);
- if (X >= maps[curMap].Width) then
- begin
- X := maps[curMap].Width - 1;
- dp.x := iMain.Width - 32;
- end
- else if (X < 0) then
- begin
- X := 0;
- dp.x := 0;
- end;
- if (Y >= maps[curMap].Height) then
- begin
- Y := maps[curMap].Height - 1;
- dp.y := iMain.Height - 32;
- end
- else if (Y < 0) then
- begin
- Y := 0;
- dp.y := 0;
- end;
- if (mode.x = 0) then
- begin
- if (High(drawTiles) <> -1) then
- if (High(drawTiles[0]) <> -1) then
- if ((maps[curMap].layers[curLay][Y][X].x = drawTiles[0][0].x) and (maps[curMap].layers[curLay][Y][X].y = drawTiles[0][0].y)) then
- exit;
- maps[curMap].layers[curLay][Y][X] := drawTiles[0][0];
- end
- else if (mode.x = 1) then
- begin
- if (maps[curMap].layers[curLay][Y][X].x = -1) then
- exit;
- maps[curMap].layers[curLay][Y][X] := Point(-1, 0)
- end
- else if (mode.x = 2) then
- begin
- h := Length(selTiles);
- if ((ssCtrl in Shift) <> (PointInTPA(Point(X, Y), selTiles))) then
- if (h <> 0) then
- exit;
- if (not (ssCtrl in Shift)) then
- begin
- SetLength(selTiles, h + 1);
- selTiles[h] := Point(X, Y);
- MaskTile(dp);
- end
- else
- begin
- if (h = 0) then
- exit;
- h := h - 1;
- for i := 0 to h - 1 do
- if ((selTiles[i].x = X) and (selTiles[i].y = Y)) then
- begin
- Swap(selTiles[i], selTiles[h]);
- break;
- end;
- SetLength(selTiles, h);
- RedrawArea(Point(X, Y), Point(X , Y), dp);
- end;
- end;
- if ((mode.x = 0) or (mode.x = 1)) then
- RedrawArea(Point(X, Y), Point(X , Y), dp);
- end;
- procedure OnToolClick(Sender: TObject);
- var
- i, ii, t: Integer;
- ar: TBox;
- begin
- t := -1;
- for i := 0 to High(bTools) do
- if (Sender = bTools[i]) then
- begin
- t := i;
- break;
- end;
- if (t = -1) then
- exit;
- if ((mode.x = 2) and (t < 2)) then
- begin
- ar := IntToBox(maps[curMap].mC.x, maps[curMap].mC.y, maps[curMap].mC.x + drawSize.x, maps[curMap].mC.y + drawSize.y);
- for i := 0 to High(selTiles) do
- if (PointInBox(selTiles[i], ar)) then
- RedrawArea(selTiles[i], selTiles[i], Point((selTiles[i].x - maps[curMap].mC.x) * 32, (selTiles[i].y - maps[curMap].mC.y) * 32)); SetLength(selTiles, 0);
- end;
- if (t = 7) then
- begin
- if (Length(selTiles) = 0) then
- exit;
- ar := GetTPABounds(selTiles);
- ar.x2 := ar.x2 - ar.x1;
- ar.y2 := ar.y2 - ar.y1;
- SetLength(drawTiles, ar.y2 + 1)
- for i := 0 to ar.y2 do
- begin
- SetLength(drawTiles[i], ar.x2 + 1);
- for ii := 0 to ar.x2 do
- drawTiles[i][ii] := Point(-2, 0);
- end;
- for i := 0 to High(selTiles) do
- drawTiles[selTiles[i].y - ar.y1][selTiles[i].x - ar.x1] := maps[curMap].layers[curLay][selTiles[i].y][selTiles[i].x];
- PaintDrawTiles;
- end
- else if (t <= 2) then
- mode.x := t
- else
- mode.y := t - 3;
- end;
- procedure OnMapScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
- var
- dir, amo: Integer;
- begin
- dir := 0;
- if (Sender = sbHorz) then
- begin
- amo := maps[curMap].mC.x - sbHorz.Position;
- maps[curMap].mC.x := sbHorz.Position;
- if (amo < 0) then
- dir := 4
- else if (amo > 0) then
- dir := 2;
- end
- else if (Sender = sbVert) then
- begin
- amo := maps[curMap].mC.y - sbVert.Position;
- maps[curMap].mC.y := sbVert.Position;
- if (amo < 0) then
- dir := 3
- else if (amo > 0) then
- dir := 1;
- end;
- if (dir = 0) then
- exit;
- HandleMovement(amo, dir);
- end;
- procedure OnTilesheetMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- drawArea := Point(Trunc(X / 32.0), Trunc(Y / 32.0));
- end;
- procedure OnTilesheetMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- var
- w, h, a, b: Integer;
- begin
- X := Trunc(X / 32.0);
- Y := Trunc(Y / 32.0);
- if (X >= shTile.w) then
- X := shTile.w - 1
- else if (X < 0) then
- X := 0;
- if (Y >= shTile.h) then
- Y := shTile.h - 1
- else if (Y < 0) then
- Y := 0;
- if (X < drawArea.x) then
- Swap(X, drawArea.x);
- if (Y < drawArea.y) then
- Swap(Y, drawArea.y);
- h := Y - drawArea.y;
- w := X - drawArea.x;
- SetLength(drawTiles, h + 1);
- for a := 0 to h do
- begin
- SetLength(drawTiles[a], w + 1);
- for b := 0 to w do
- drawTiles[a][b] := Point((drawArea.x + b) * 32, (drawArea.y + a) * 32);
- end;
- PaintDrawTiles;
- end;
- procedure OnButtonClick(Sender: TObject);
- begin
- if (Sender = bLayUp) then
- begin
- curLay := curLay + 1;
- if (curLay >= maps[curMap].depth) then
- curLay := 0;
- end
- else
- begin
- curLay := curLay - 1;
- if (curLay <= -1) then
- curLay := maps[curMap].depth - 1;
- end;
- lCurLay.Caption := 'Layer ' + IntToStr(curLay) + ' selected'; // Update the layer caption so we know where we are drawing at
- end;
- procedure OnMenuClick(Sender: TObject);
- var
- i, opt: Integer;
- begin
- opt := -1;
- for i := 0 to High(mFileOpts) do
- if (Sender = mFileOpts[i]) then
- begin
- opt := i;
- break;
- end;
- if (opt = -1) then
- begin
- Writeln('I don''t know how you managed it, but you clicked on a non-existent menu item');
- exit;
- end;
- case opt of
- 0: NewMap;
- 1: ImportMap;
- 2: ExportMap;
- 3: CloseMap(curMap);
- 4: begin RedrawMap(maps[curMap]); PaintMap; end;
- end;
- sbHorz.Position := maps[curMap].mC.x;
- sbVert.Position := maps[curMap].mC.y;
- end;
- procedure OnTabChange(Sender: TObject);
- begin
- curMap := tcMain.TabIndex;
- sbHorz.Position := maps[curMap].mC.x;
- sbHorz.Max := maps[curMap].Width - drawSize.x;
- sbVert.Position := maps[curMap].mC.y;
- sbVert.Max := maps[curMap].Height - drawSize.y;
- PaintMap;
- end;
- procedure DeleteRowCol(pos: TPoint; row: Boolean);
- var
- x, y, z: Integer;
- begin
- for z := 0 to maps[curMap].depth - 1 do
- begin
- if (row) then
- begin
- for y := pos.y + 1 to maps[curMap].height - 1 do
- Swap(maps[curMap].layers[z][y - 1], maps[curMap].layers[z][y]);
- SetLength(maps[curMap].layers[z], maps[curMap].height - 1);
- end
- else
- for y := 0 to maps[curMap].height - 1 do
- begin
- for x := pos.x + 1 to maps[curMap].width - 1 do
- Swap(maps[curMap].layers[z][y][x - 1], maps[curMap].layers[z][y][x]);
- SetLength(maps[curMap].layers[z][y], maps[curMap].width - 1);
- end;
- end;
- if (row) then
- maps[curMap].height := maps[curMap].height - 1
- else
- maps[curMap].width := maps[curMap].width - 1;
- sbHorz.Max := maps[curMap].Width - drawSize.x;
- sbVert.Max := maps[curMap].Height - drawSize.y;
- end;
- procedure InsertRowCol(pos: TPoint; row: Boolean);
- var
- x, y, z: Integer;
- begin
- for z := 0 to maps[curMap].depth - 1 do
- begin
- if (row) then
- begin
- SetLength(maps[curMap].layers[z], maps[curMap].height + 1);
- SetLength(maps[curMap].layers[z][maps[curMap].height], maps[curMap].width);
- for x := 0 to maps[curMap].width - 1 do
- maps[curMap].layers[z][maps[curMap].height][x] := Point(-1, 0);
- for y := maps[curMap].height downto pos.y + 1 do
- Swap(maps[curMap].layers[z][y - 1], maps[curMap].layers[z][y]);
- end
- else
- begin
- for y := 0 to maps[curMap].height - 1 do
- begin
- SetLength(maps[curMap].layers[z][y], maps[curMap].width + 1);
- maps[curMap].layers[z][y][maps[curMap].width] := Point(-1, 0);
- for x := maps[curMap].width downto pos.x + 1 do
- Swap(maps[curMap].layers[z][y][x - 1], maps[curMap].layers[z][y][x]);
- end;
- end;
- end;
- if (row) then
- maps[curMap].height := maps[curMap].height + 1
- else
- maps[curMap].width := maps[curMap].width + 1;
- sbHorz.Max := maps[curMap].Width - drawSize.x;
- sbVert.Max := maps[curMap].Height - drawSize.y;
- end;
- procedure OnPopupClick(Sender: TObject);
- var
- a, b, c: Integer;
- f: Boolean;
- begin
- f := False;
- for a := 0 to Length(pmOpts) - 1 do
- if (f) then
- break
- else
- for b := 0 to Length(pmOpts[a]) - 1 do
- if (f) then
- break
- else
- for c := 0 to Length(pmOpts[a][b]) - 1 do
- if (Sender = pmOpts[a][b][c]) then
- begin
- f := True;
- break;
- end;
- if (not f) then
- begin
- Writeln('Invalid menu item pointing to OnPopupClick');
- exit;
- end;
- a := a - 1;
- b := b - 1;
- if (a = 1) then
- begin
- if ((c = 0) or (c = 1) or (c = 3)) then
- begin
- if (c = 1) then
- drawArea := Point(drawArea.x - 1, drawArea.y - 1)
- else if (c = 3) then
- drawArea := Point(drawArea.x + 1, drawArea.y + 1);
- DeleteRowCol(drawArea, b = 0);
- end
- else
- begin
- a := -1
- while a = -1 do
- a := StrToIntDef(Readln('How many to delete (0 to cancel)'), -1);
- if (a = 0) then
- exit;
- if (c = 2) then
- drawArea := Point(drawArea.x - a, drawArea.y - a)
- else
- drawArea := Point(drawArea.x + 1, drawArea.y + 1);
- for c := 1 to a do
- DeleteRowCol(Point(drawArea.x, drawArea.y), b = 0);
- end;
- end
- else
- begin
- if ((c = 0) or (c = 2)) then
- begin
- if (c = 2) then
- drawArea := Point(drawArea.x + 1, drawArea.y + 1);
- InsertRowCol(drawArea, b = 0);
- end
- else
- begin
- a := -1
- while a = -1 do
- a := StrToIntDef(Readln('How many to insert (0 to cancel)'), -1);
- if (a = 0) then
- exit;
- if (c = 3) then
- drawArea := Point(drawArea.x + 1, drawArea.y + 1);
- for c := 1 to a do
- InsertRowCol(Point(drawArea.x, drawArea.y), b = 0);
- end;
- end;
- RedrawMap(maps[curMap]);
- PaintMap;
- end;
- procedure ApplyGrid(var img: TImage; col: Integer);
- var
- x, y, xl, yl, tc: Integer;
- begin
- xl := img.Width div 32;
- yl := img.Height div 32;
- tc := img.Canvas.Pen.Color;
- img.Canvas.Pen.Color := col;
- if (yl > 2) then
- for y := 1 to yl - 1 do
- begin
- img.Canvas.MoveTo(0, y * 32);
- img.Canvas.LineTo(img.Width, y * 32);
- end;
- if (xl > 2) then
- for x := 1 to xl - 1 do
- begin
- img.Canvas.MoveTo(x * 32, 0);
- img.Canvas.LineTo(x * 32, img.Height);
- end;
- img.Canvas.Pen.Color := tc;
- end;
- // Standard form setup procedure - no comments
- procedure SetupForm;
- var
- i, ii, iii: Integer;
- popMode, popDir: TStringArray;
- popAmount: array of TStringArray;
- begin
- fMain := CreateForm;
- mMain := TMainMenu.Create(fMain);
- mFile := TMenuItem.Create(fMain);
- mFIle.Caption := 'File';
- menuNames := ['New', 'Open', 'Save', 'Close', 'Refresh'];
- SetLength(mFileOpts, Length(menuNames));
- for i := 0 to High(mFileOpts) do
- begin
- mFileOpts[i] := TMenuItem.Create(fMain);
- mFileOpts[i].Caption := menuNames[i];
- mFileOpts[i].OnClick := @OnMenuClick;
- mFIle.Add(mFileOpts[i]);
- end;
- mMain.Items.Add(mFile);
- with fMain do
- begin
- Caption := 'ScaRPG - Map Editor';
- ClientWidth := ((drawSize.x + 1) * 32) + ((shTile.w + 1) * 32) + 32;
- ClientHeight := ((drawSize.y + 1) * 32) + 32;
- Position := poDesktopCenter;
- end;
- pSheet := TPanel.Create(fMain);
- with pSheet do
- begin
- Parent := fMain;
- Width := (shTile.w + 1) * 32;
- Height := fMain.ClientHeight;
- Left := fMain.ClientWidth - Width;
- Top := 0;
- end;
- sbSheet := TScrollBox.Create(pSheet);
- with sbSheet do
- begin
- Parent := pSheet;
- Align := alClient;
- VertScrollBar.Increment := 32;
- end;
- iSheet := TImage.Create(sbSheet);
- with iSheet do
- begin
- Parent := sbSheet;
- Left := 0;
- Top := 0;
- Width := (shTile.w * 32);
- Height := (shTile.h * 32);
- SafeDrawBitmap(shTile.b, Canvas, 0, 0);
- OnMouseDown := @OnTilesheetMouseDown;
- OnMouseUp := @OnTilesheetMouseUp;
- ApplyGrid(iSheet, clRed);
- end;
- pTile := TPanel.Create(pSheet);
- with pTile do
- begin
- Parent := pSheet;
- Align := alBottom;
- Height := 96;
- end;
- iTile := TImage.Create(pTile);
- with iTile do
- begin
- Parent := pTile;
- Left := 16;
- Top := 16;
- Width := 64;
- Height := 64;
- PaintDrawTiles;
- end;
- bLayUp := TButton.Create(pTile);
- with bLayUp do
- begin
- Parent := pTile;
- Left := 96;
- Top := 16;
- Width := 32;
- Height := 32;
- Caption := '^';
- OnClick := @OnButtonClick;
- end;
- bLayDo := TButton.Create(pTile);
- with bLayDo do
- begin
- Parent := pTile;
- Left := 96;
- Top := 48;
- Width := 32;
- Height := 32;
- Caption := 'v';
- OnClick := @OnButtonClick;
- end;
- toolHints := ['Draw', 'Erase', 'Select', 'Flood', 'Pencil', 'Tile', 'Box', 'Copy'];
- SetLength(bTools, Length(toolHints));
- for i := 0 to High(toolHints) do
- begin
- bTools[i] := TButton.Create(pTile);
- with bTools[i] do
- begin
- Parent := pTile;
- Left := 144 + ((i mod 4) * 32);
- Top := 16 + ((i div 4) * 32);
- Width := 32;
- Height := 32;
- Hint := toolHints[i];
- Caption := Copy(toolHints[i], 1, 4);
- OnClick := @OnToolClick;
- end;
- end;
- lCurLay := TLabel.Create(pTile);
- with lCurLay do
- begin
- Parent := pTile;
- Left := 16;
- Top := 0;
- Caption := 'Layer ' + IntToStr(curLay) + ' selected';
- end;
- tcMain := TTabControl.Create(fMain);
- with tcMain do
- begin
- Parent := fMain;
- Left := 0;
- Top := 0;
- Width := (drawSize.x * 32) + 48;
- Height := (drawSize.y * 32) + 64;
- AddMap(20, 20, 3);
- OnChange := @OnTabChange;
- end;
- iMain := TImage.Create(tcMain);
- with iMain do
- begin
- Parent := tcMain;
- Left := 16;
- Top := 32;
- Width := drawSize.x * 32;
- Height := drawSize.y * 32;
- OnMouseDown := @OnMapMouseDown;
- OnMouseUp := @OnMapMouseUp;
- OnMouseMove := @OnMapMouseMove;
- ApplyGrid(iMain, clRed);
- end;
- sbHorz := TScrollBar.Create(tcMain);
- with sbHorz do
- begin
- Parent := tcMain;
- Left := 16;
- Top := 32 + iMain.Height;
- Width := iMain.Width;
- Height := 16;
- Kind := sbHorizontal;
- Max := maps[curMap].Width - drawSize.x;
- OnScroll := @OnMapScroll;
- end;
- sbVert := TScrollBar.Create(tcMain);
- with sbVert do
- begin
- Parent := tcMain;
- Left := 16 + iMain.Width;
- Top := 32;
- Width := iMain.Width;
- Height := 16;
- Kind := sbVertical;
- Max := maps[curMap].Height - drawSize.y;
- OnScroll := @OnMapScroll;
- end;
- ppMain := TPopupMenu.Create(fMain);
- popMode := ['Insert', 'Delete', 'Cancel'];
- SetLength(pmMain, Length(popMode));
- for i := 0 to Length(popMode) - 1 do
- begin
- pmMain[i] := TMenuItem.Create(fMain);
- pmMain[i].Caption := popMode[i];
- end;
- popDir := ['Row', 'Column'];
- SetLength(pmSub, Length(pmMain) - 1);
- for i := 0 to Length(pmSub) - 1 do
- begin
- SetLength(pmSub[i], Length(popDir));
- for ii := 0 to Length(pmSub[i]) - 1 do
- begin
- pmSub[i][ii] := TMenuItem.Create(fMain);
- pmSub[i][ii].Caption := popDir[ii];
- end;
- end;
- SetLength(popAmount, Length(pmSub));
- for i := 0 to Length(popAmount) - 1 do
- case i of
- 0: popAmount[i] := ['1 Before', 'x Before', '1 After', 'x After'];
- 1: popAmount[i] := ['Current', 'Previous', 'Previous x', 'Next', 'Next x'];
- end;
- SetLength(pmOpts, Length(pmSub));
- for i := 0 to Length(pmOpts) - 1 do
- begin
- SetLength(pmOpts[i], Length(pmSub[i]));
- for ii := 0 to Length(pmOpts[i]) - 1 do
- begin
- SetLength(pmOpts[i][ii], Length(popAmount[i]));
- for iii := 0 to Length(pmOpts[i][ii]) - 1 do
- begin
- pmOpts[i][ii][iii] := TMenuItem.Create(fMain);
- pmOpts[i][ii][iii].Caption := popAmount[i][iii];
- pmOpts[i][ii][iii].OnClick := @OnPopupClick;
- pmSub[i][ii].Add(pmOpts[i][ii][iii]);
- end;
- end;
- end;
- for i := 0 to Length(pmSub) - 1 do
- for ii := 0 to Length(pmSub[i]) - 1 do
- pmMain[i].Add(pmSub[i][ii]);
- for i := 0 to Length(popMode) - 1 do
- ppMain.Items.Add(pmMain[i]);
- RedrawMap(maps[curMap]);
- PaintMap;
- fMain.ShowModal;
- end;
- var
- v: TVariantArray;
- m, z, i: Integer;
- // Main loop - no comments
- begin
- Writeln('begin');
- drawSize := Point(15, 15);
- mode := Point(0, 1);
- LoadSheet(shTile, ScriptPath + 'Tiles.bmp');
- ThreadSafeCall('SetupForm', v);
- // SetupForm; // Use without SafeCall for debugging unknown errors, though very prone to self destruct when done so - use at own risk
- FreeForm(fMain);
- for m := 0 to High(maps) do
- for z := 0 to maps[m].depth - 1 do
- MFreeBitmap(maps[m].vis[z]);
- FreeBitmap(shTile.b);
- // Section for debugging memory leaks - see MBitmap and MFreeBitmap
- // Don't rely on it for fixing all leaks - only works when you use MBitmap and not LoadBitmap etc.
- while True do
- begin
- i := Pos('1', bitDeb);
- if (i = 0) then
- Break;
- Writeln('Bitmap created from ''' + bitLoc[i] + ''' not freed!');
- MFreeBitmap(i - 1);
- end;
- Writeln('end');
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement