SRL Archive - Help and Support

While working on my map editor, I came across an unusual error to say the least. I know it has something to do with the large amount of bitmap copying I'm doing and I know I can fix it by using smaller bitmaps, but the problem is that I would have to just about rewrite the entire code again for the 3rd time. Anyway, the exact error is "Can't allocate the DIB Handle" and it messes up most of the screen visually, though it is fixed when I move a window or resize etc. I'm hoping there is an easy way around this, but I'm prepared for the worst :(

Perhaps:

frmDesign.Hide;
frmDesign.Show;

Should work…

I tried using that in a few different places, but it didn't fix it. I tried hiding before the bitmap drawing and showing afterwards, hiding and showing after the drawing and a few other random places. I also tried breaking up the drawing into smaller bits, but that also didn't help. I think that it may be due to the canvas size now as well, as it seems to happen consistently with certain larger sizes, but not different amounts of layers (a map is made up of layers, which are just separate images placed on top of each other in a specific order), so it could be because of that.

Would you like to post the form?

Good luck understanding most of it :)

program MixstersMapEditor;
const
  WriteDebug = True;
type
  Size = record
    l: Integer;
    x: Integer;
    y: Integer;
  end;
  
  Visual = record
    Tile: Integer;
    Sheet: Integer;
    Rotate: Integer;
  end;

  Map = record
    Name: string;
    Size: Size;
    Vis: array of array of array of Visual;
    Att: array of array of Integer;
  end;

  SelectedTile = record
    Tile: Integer;
    Sheet: Integer;
    Vis: TImage;
  end;

var
  MainMap: Map;
  GfxPath, MapPath: string;
  MapFrm, ToolFrm: TForm;
  MainMnu: TMainMenu;
  FileMnu, NewMnu, OpenMnu, SaveMnu, RandMnu: TMenuItem;
  OptionMnu, ToolMnu, PropertyMnu: TMenuItem;
  dlgOpen: TOpenDialog;
  dlgSave: TSaveDialog;
  MapPnl, ToolPnl: TPanel;
  MapImg, ToolImg: TImage;
  MapScb, ToolScb: TScrollBox;
  SelLayer: array of TRadioButton;
  VisLayer: array of TCheckBox;
  TileSheets: array of TImage;
  PageControl: TPageControl;
  TilesheetsTab: array of TTabSheet;
  SelTile: SelectedTile;
  xMD, yMD: Integer;

procedure Write(s: string);
begin
  if WriteDebug then
    WriteLn(s);
end;
  
function WriteMapDNA: string;
var
  Time, l, x, y: Integer;
begin
  Time := GetSystemTime;
  
  Result := MainMap.Name + ':' + IntToStr(MainMap.Size.l) + ',' + IntToStr(MainMap.Size.x) + ',' + IntToStr(MainMap.Size.y) + ',';
  for l := 0 to MainMap.Size.l - 1 do
    for x := 0 to MainMap.Size.x - 1 do
      for y := 0 to MainMap.Size.y - 1 do
        Result := Result + IntToStr(MainMap.Vis[l][x][y].Tile) + '.' + IntToStr(MainMap.Vis[l][x][y].Sheet) + '.' + IntToStr(MainMap.Vis[l][x][y].Rotate) + ',';
  for x := 0 to MainMap.Size.x - 1 do
    for y := 0 to MainMap.Size.y - 1 do
      Result := Result + IntToStr(MainMap.Att[x][y]) + ',';
  SetLength(Result, Length(Result) - 1);
  Write('Wrote ' + IntToStr((MainMap.Size.l * MainMap.Size.x * MainMap.Size.y) + (MainMap.Size.x * MainMap.Size.y)) + ' tiles for a map string in ' + IntToStr(GetSystemTime - Time) + 'ms');
end;

procedure SetTilesDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: Integer); forward;
procedure SetTilesUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: Integer); forward;

procedure ReadMapDNA(sMap: string);
var
  p, l, x, y, Time: Integer;
  tmpTile: string;
begin
  Time := GetSystemTime;
  p := Pos(':', sMap);
  MainMap.Name := Copy(sMap, 1, p - 1);
  Delete(sMap, 1, p);
  p := Pos(',', sMap);
  MainMap.Size.l := StrToInt(Copy(sMap, 1, p - 1));
  Delete(sMap, 1, p);
  p := Pos(',', sMap);
  MainMap.Size.x := StrToInt(Copy(sMap, 1, p - 1));
  Delete(sMap, 1, p);
  p := Pos(',', sMap);
  MainMap.Size.y := StrToInt(Copy(sMap, 1, p - 1));
  Delete(sMap, 1, p);
  Write(MainMap.Name + ' - ' + IntToStr(MainMap.Size.l) + ',' + IntToStr(MainMap.Size.x) + ',' + IntToStr(MainMap.Size.y))

  SetArrayLength(MainMap.Vis, MainMap.Size.l);
  SetArrayLength(MainMap.Att, MainMap.Size.x);
  for l := 0 to MainMap.Size.l - 1 do
  begin
    SetArrayLength(MainMap.Vis[l], MainMap.Size.x);
    for x := 0 to MainMap.Size.x - 1 do
    begin
      SetArrayLength(MainMap.Vis[l][x], MainMap.Size.y);
      if l = 0 then
        SetArrayLength(MainMap.Att[x], MainMap.Size.y);
    end;
  end;

  for l := 0 to MainMap.Size.l - 1 do
    for x := 0 to MainMap.Size.x - 1 do
      for y := 0 to MainMap.Size.y - 1 do
      begin
        p := Pos(',', sMap);
        tmpTile := Copy(sMap, 1, p);
        Delete(sMap, 1, p);
        p := Pos('.', tmpTile);
        MainMap.Vis[l][x][y].Tile := StrToInt(Copy(tmpTile, 1, p - 1));
        Delete(tmpTile, 1, p);
        p := Pos('.', tmpTile);
        MainMap.Vis[l][x][y].Sheet := StrToInt(Copy(tmpTile, 1, p - 1));
        Delete(tmpTile, 1, p);
        MainMap.Vis[l][x][y].Rotate := StrToInt(Copy(tmpTile, 1, Length(tmpTile) - 1));
        Delete(tmpTile, 1, Length(tmpTile));
      end;
  for x := 0 to MainMap.Size.x - 1 do
    for y := 0 to MainMap.Size.y - 1 do
    begin
      if (x = MainMap.Size.x - 1) and (y = MainMap.Size.y - 1) then
        Break;
      p := Pos(',', sMap);
      MainMap.Att[x][y] := StrToInt(Copy(sMap, 1, p - 1));
      Delete(sMap, 1, p);
    end;
  MainMap.Att[MainMap.Size.x - 1][MainMap.Size.y - 1] := StrToInt(Copy(sMap, 1, Length(sMap)));
  Delete(sMap, 1, Length(sMap));
  MapImg.Free;
  MapImg := TImage.Create(MapScb);
  MapImg.Parent := MapScb;
  MapImg.OnMouseDown := @SetTilesDown;
  MapImg.OnMouseUp := @SetTilesUp;
  Write('Read ' + IntToStr((MainMap.Size.l * MainMap.Size.x * MainMap.Size.y) + (MainMap.Size.x * MainMap.Size.y)) + ' tiles in ' + IntToStr(GetSystemTime - Time) + 'ms');
end;

procedure RandomMapDNA;
var
  l, x, y: Integer;
begin

  MainMap.Name := 'Random';
  MainMap.Size.l := Random(3) + 3;
  MainMap.Size.x := Random(20) + 5;
  MainMap.Size.y := Random(20) + 5;
  SetArrayLength(MainMap.Vis, MainMap.Size.l);
  SetArrayLength(MainMap.Att, MainMap.Size.x);
  for l := 0 to MainMap.Size.l - 1 do
  begin
    SetArrayLength(MainMap.Vis[l], MainMap.Size.x);
    for x := 0 to MainMap.Size.x - 1 do
    begin
      SetArrayLength(MainMap.Vis[l][x], MainMap.Size.y);
      if l = 0 then
        SetArrayLength(MainMap.Att[x], MainMap.Size.y);
    end;
  end;

  for l := 0 to MainMap.Size.l - 1 do
    for x := 0 to MainMap.Size.x - 1 do
      for y := 0 to MainMap.Size.y - 1 do
      begin
        MainMap.Vis[l][x][y].Tile := Random(100);
        MainMap.Vis[l][x][y].Sheet := 0;
        MainMap.Vis[l][x][y].Rotate := Random(4);
        if l = 0 then
          MainMap.Att[x][y] := Random(5);
      end;
  MapImg.Free;
  MapImg := TImage.Create(MapScb);
  MapImg.Parent := MapScb;
  MapImg.Left := 0;
  MapImg.Top := 0;
  MapImg.OnMouseDown := @SetTilesDown;
  MapImg.OnMouseUp := @SetTilesUp;
  Write('Generated random map with dimensions of ' + IntToStr(MainMap.Size.l) + ' x ' + IntToStr(MainMap.Size.x) + ' x ' + IntToStr(MainMap.Size.y))
end;

procedure NewMapDNA;
var
  l, x, y: Integer;
begin
  MainMap.Name := 'New';
  MainMap.Size.l := 5;
  MainMap.Size.x := 10;
  MainMap.Size.y := 10;
  SetArrayLength(MainMap.Vis, MainMap.Size.l);
  SetArrayLength(MainMap.Att, MainMap.Size.x);
  for l := 0 to MainMap.Size.l - 1 do
  begin
    SetArrayLength(MainMap.Vis[l], MainMap.Size.x);
    for x := 0 to MainMap.Size.x - 1 do
    begin
      SetArrayLength(MainMap.Vis[l][x], MainMap.Size.y);
      if l = 0 then
        SetArrayLength(MainMap.Att[x], MainMap.Size.y);
    end;
  end;

  for l := 0 to MainMap.Size.l - 1 do
    for x := 0 to MainMap.Size.x - 1 do
      for y := 0 to MainMap.Size.y - 1 do
      begin
        MainMap.Vis[l][x][y].Tile := 0;
        MainMap.Vis[l][x][y].Sheet := 0;
        MainMap.Vis[l][x][y].Rotate := 0;
        if l = 0 then
          MainMap.Att[x][y] := 0;
      end;
  Write('Generated new map')
end;

procedure SetSelTile(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: Integer); forward;

procedure ShowTab(Sender: TObject);
var
  i, tempBmp: Integer;
begin
  for i := 0 to GetArrayLength(TilesheetsTab) - 1 do
    if TilesheetsTab[i] = Sender then
    begin
      SelTile.Sheet := i;
      ToolPnl.Width := TileSheets[i].Width + 21;
      ToolScb.Width := ToolPnl.Width;
      ToolImg.Free;
      ToolImg := TImage.Create(ToolScb);
      ToolImg.Parent := ToolScb;
      ToolImg.Width := ToolPnl.Width - 21;
      ToolImg.Height := TileSheets[i].Height;
      ToolImg.OnMouseUp:= @SetSelTile;
      CopyCanvas(TileSheets[i].Canvas, ToolImg.Canvas, 0, 0, TileSheets[i].Width, TileSheets[i].Height, 0, 0, ToolImg.Width, ToolImg.Height);
      tempBmp := BitmapFromString(32, 32, '');
      FastDrawClear(tempBmp, 0);
      SafeDrawBitmap(tempBmp, SelTile.Vis.Canvas, 0, 0);
    end;
end;

procedure LoadTileSheets;
var
  i, ii, tempBmp, x, y: Integer;
begin
  while FileExists(GfxPath + 'Tiles' + IntToStr(i) + '.bmp') do
  begin
    tempBmp := LoadBitmap(GfxPath + 'Tiles' + IntToStr(i) + '.bmp');
    GetBitmapSize(tempBmp, x, y);
    SetArrayLength(TileSheets, i + 1);
    TileSheets[i] := TImage.Create(MapFrm);
    TileSheets[i].Width := x;
    TileSheets[i].Height := y;
    SafeDrawBitmap(tempBmp, TileSheets[i].Canvas, 1, 1);
    FreeBitmap(tempBmp);
    i := i + 1;
  end;
  SetArrayLength(TilesheetsTab, i);
  for ii := 0 to i - 1 do
  begin
    TilesheetsTab[ii] := TTabSheet.Create(ToolFrm);
    TilesheetsTab[ii].Caption := 'Tab ' + IntToStr(ii);
    TilesheetsTab[ii].PageControl := PageControl;
    TilesheetsTab[ii].OnShow := @ShowTab;
  end;
  ToolPnl.Width := TileSheets[0].Width + 21;
  ToolScb.Width := ToolPnl.Width;
  ToolImg.Width := ToolPnl.Width - 21;
  ToolImg.Height := TileSheets[0].Height;
  CopyCanvas(TileSheets[0].Canvas, ToolImg.Canvas, 0, 0, TileSheets[0].Width, TileSheets[0].Height, 0, 0, ToolImg.Width, ToolImg.Height);
  tempBmp := BitmapFromString(32, 32, '');
  FastDrawClear(tempBmp, 0);
  SafeDrawBitmap(tempBmp, SelTile.Vis.Canvas, 0, 0);
end;

function TileToPoint(tileID, sheet: Integer): TPoint;
var
  w, h: Integer;
begin
  w := TileSheets[sheet].Width div 32;
  h := TileSheets[sheet].Height div 32;
  Result.x := ((tileID mod w) * 32) + 1;
  Result.y := ((tileID div w) * 32) + 1;
end;

function PointToTile(Pos: TPoint; sheet: Integer): Integer;
var
  w: Integer;
begin
  w := TileSheets[sheet].Width div 32;
  Result := ((Pos.y div 32) * w) + (Pos.x div 32);
end;

procedure UpdateLayerControl; forward;

procedure PaintMap;
var
  l, x, y, Time, tempBmp, Buffer: Integer;
  tP: TPoint;
begin
  Time := GetSystemTime;
  MapImg.Width := MainMap.Size.x * 32;
  MapImg.Height := MainMap.Size.y * 32;
  Buffer := BitmapFromString(MainMap.Size.x * 32, MainMap.Size.y * 32, '');
  FastDrawClear(Buffer, 0);
  SafeDrawBitmap(Buffer, MapImg.Canvas, 0, 0);
  UpdateLayerControl;
  for l := 0 to MainMap.Size.l - 1 do
  begin
    if VisLayer[l].Checked then
      for x := 0 to MainMap.Size.x - 1 do
        for y := 0 to MainMap.Size.y - 1 do
        begin
          tP := TileToPoint(MainMap.Vis[l][x][y].Tile, MainMap.Vis[l][x][y].Sheet);
          tempBmp := BitmapFromString(32, 32, '');
          SafeCopyCanvas(TileSheets[MainMap.Vis[l][x][y].Sheet].Canvas, GetBitmapCanvas(tempBmp), tP.x + 1, tP.y + 1, tP.x + 32, tP.y + 32, 0, 0, 32, 32);
          tempBmp := RotateBitmap(tempBmp, MainMap.Vis[l][x][y].Rotate * Radians(90));
          SetTransparentColor(tempBmp, 0);
          FastDrawTransparent(x * 32, y * 32, tempBmp, Buffer);
          FreeBitmap(tempBmp);
        end;
  end;
  SafeDrawBitmap(Buffer, MapImg.Canvas, 0, 0);
  FreeBitmap(Buffer);
  Write('Painted ' + IntToStr(MainMap.Size.l * MainMap.Size.x * MainMap.Size.y) + ' tiles in ' + IntToStr(GetSystemTime - Time) + 'ms');
end;

procedure PaintMapSender(Sender: TObject);
begin
  PaintMap;
end;

procedure PaintTiles(x1, y1, x2, y2: Integer);
var
  l, x, y, Time, tempBmp, Buffer: Integer;
  tP: TPoint;
begin
  Time := GetSystemTime;
  Buffer := BitmapFromString(MainMap.Size.x * 32, MainMap.Size.y * 32, '');
  SafeCopyCanvas(MapImg.Canvas, GetBitmapCanvas(Buffer), 1, 1, MainMap.Size.x * 32, MainMap.Size.y * 32, 1, 1, MainMap.Size.x * 32, MainMap.Size.y * 32);
  for l := 0 to MainMap.Size.l - 1 do
    if VisLayer[l].Checked then
      for x := x1 to x2 do
        for y := y1 to y2 do
        begin
          tP := TileToPoint(MainMap.Vis[l][x][y].Tile, MainMap.Vis[l][x][y].Sheet);
          tempBmp := BitmapFromString(32, 32, '');
          SafeCopyCanvas(TileSheets[MainMap.Vis[l][x][y].Sheet].Canvas, GetBitmapCanvas(tempBmp), tP.x, tP.y, tP.x + 32, tP.y + 32, 0, 0, 32, 32);
          tempBmp := RotateBitmap(tempBmp, MainMap.Vis[l][x][y].Rotate * Radians(90));
          SetTransparentColor(tempBmp, 0);
          FastDrawTransparent(x * 32, y * 32, tempBmp, Buffer);
          FreeBitmap(tempBmp);
        end;

  SafeDrawBitmap(Buffer, MapImg.Canvas, 0, 0);
  FreeBitmap(Buffer);
  Write('Repainted ' + IntToStr(MainMap.Size.l * (x2 - x1 + 1) * (y2 - y1 + 1)) + ' tiles in ' + IntToStr(GetSystemTime - Time) + 'ms');
end;

procedure SetSelTile(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: Integer);
var
  tP: TPoint;
begin
  tP.x := x;
  tP.y := y;
  SelTile.Tile := PointToTile(tP, SelTile.Sheet);
  tP := TileToPoint(SelTile.Tile, SelTile.Sheet);
  SafeCopyCanvas(TileSheets[SelTile.Sheet].Canvas, SelTile.Vis.Canvas, tP.x, tP.y, tP.x + 32, tP.y + 32, 0, 0, 32, 32);
end;

procedure SetTilesDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: Integer);
var
  l: Integer;
begin
  case Button of
    mbLeft:
    begin
      xMD := x;
      yMD := y;
    end;
    mbRight:
    begin
      while (l < MainMap.Size.l) and (not SelLayer[l].Checked) do
        Inc(l);
      MainMap.Vis[l][x div 32][y div 32].Rotate := MainMap.Vis[l][x div 32][y div 32].Rotate + 1;
      if MainMap.Vis[l][x div 32][y div 32].Rotate >= 4 then
        MainMap.Vis[l][x div 32][y div 32].Rotate := 0;
      PaintTiles(x div 32, y div 32, x div 32, y div 32);
    end;
  end;
end;

procedure SetTilesUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: Integer);
var
  xMU, yMU, l, xF, yF: Integer;
begin
  if Button = mbRight then
    Exit;
  if x >= xMD then
  begin
    xMU := x div 32;
    xMD := xMD div 32;
  end
  else
  begin
    xMU := xMD div 32;
    xMD := x div 32;
  end;
  if y >= yMD then
  begin
    yMU := y div 32;
    yMD := yMD div 32;
  end
  else
  begin
    yMU := yMD div 32;
    yMD := y div 32;
  end;
  while (l < MainMap.Size.l) and (not SelLayer[l].Checked) do
    Inc(l);
  for xF := xMD to xMU do
    for yF := yMD to yMU do
    begin
      MainMap.Vis[l][xF][yF].Tile := SelTile.Tile;
      MainMap.Vis[l][xF][yF].Sheet := SelTile.Sheet;
      MainMap.Vis[l][xF][yF].Rotate := 0;
    end;
  PaintTiles(xMD, yMD, xMU, yMU);
end;

procedure UpdateMapVis;
var
  tL, tX, tY, l, x, y: Integer;
begin
  tL := GetArrayLength(MainMap.Vis);
  tX := GetArrayLength(MainMap.Vis[0]);
  tY := GetArrayLength(MainMap.Vis[0][0]);
  SetArrayLength(MainMap.Vis, MainMap.Size.l);
  SetArrayLength(MainMap.Att, MainMap.Size.x);
  
  for l := 0 to MainMap.Size.l - 1 do
  begin
    SetArrayLength(MainMap.Vis[l], MainMap.Size.x);
    for x := 0 to MainMap.Size.x - 1 do
    begin
      SetArrayLength(MainMap.Vis[l][x], MainMap.Size.y);
      if l = 0 then
        SetArrayLength(MainMap.Att[x], MainMap.Size.y);
    end;
  end;

  for l := 0 to MainMap.Size.l - 1 do
    for x := 0 to MainMap.Size.x - 1 do
      for y := 0 to MainMap.Size.y - 1 do
      begin
        MainMap.Vis[l][x][y].Tile := 0;
        MainMap.Vis[l][x][y].Sheet := 0;
        MainMap.Vis[l][x][y].Rotate := 0;
        if l = tL then
          MainMap.Att[x][y] := 0;
      end;
end;

procedure ShowToolForm; forward;

procedure MenuActions(Sender: TObject);
var
  myFile: Integer;
  fileS: string;
begin
  case Sender of
    NewMnu: begin
      NewMapDNA;
      PaintMap;
    end;
    OpenMnu: begin
      dlgOpen.Execute;
      if dlgOpen.FileName = '' then
        Exit;
      myFile := OpenFile(dlgOpen.FileName, False);
      ReadFileString(myFile, fileS, FileSize(myFile));
      ReadMapDNA(fileS);
      CloseFile(myFile);
      PaintMap;
    end;
    SaveMnu: begin
      dlgSave.Execute;
      if dlgSave.FileName = '' then
        Exit;
      if (not (Right(dlgSave.FileName, 7) = '.mixmap')) then
        dlgSave.FileName := dlgSave.FileName + '.mixmap';
      myFile := RewriteFile(dlgSave.FileName, False);
      WriteFileString(myFile, WriteMapDNA);
      CloseFile(myFile);
    end;
    RandMnu: begin
      RandomMapDNA;
      PaintMap;
    end;
    ToolMnu: ShowToolForm;
    PropertyMnu: begin
      MainMap.Size.l := StrToIntDef(ReadLn('Layers:'), 5);
      MainMap.Size.x := StrToIntDef(ReadLn('Width:'), 10);
      MainMap.Size.y := StrToIntDef(ReadLn('Height:'), 10);
      MapImg.Free;
      MapImg := TImage.Create(MapScb);
      MapImg.Parent := MapScb;
      MapImg.Left := 0;
      MapImg.Top := 0;
      MapImg.OnMouseDown := @SetTilesDown;
      MapImg.OnMouseUp := @SetTilesUp;
      UpdateMapVis;
      PaintMap;
    end;
  end;
end;

procedure UpdateLayerControl;
var
  l: Integer;
begin
  if GetArrayLength(SelLayer) = MainMap.Size.l then
    Exit;
  if GetArrayLength(SelLayer) <> 0 then
    for l := 0 to GetArrayLength(SelLayer) - 1 do
    begin
      SelLayer[l].Free;
      VisLayer[l].Free;
    end;
  SetArrayLength(SelLayer, 0);
  SetArrayLength(VisLayer, 0);
  SetArrayLength(SelLayer, MainMap.Size.l);
  SetArrayLength(VisLayer, MainMap.Size.l);
  for l := 0 to MainMap.Size.l - 1 do
  begin
    SelLayer[l] := TRadioButton.Create(ToolPnl);
    VisLayer[l] := TCheckBox.Create(ToolPnl);
    SelLayer[l].Parent := ToolPnl;
    VisLayer[l].Parent := ToolPnl;
    SelLayer[l].Top := ToolPnl.Height - 48;
    SelLayer[l].Left := 52 + (l * 16);
    VisLayer[l].Top := SelLayer[l].Top + 16;
    VisLayer[l].Left := SelLayer[l].Left;
    VisLayer[l].Checked := True;
    VisLayer[l].OnClick := @PaintMapSender;
  end;
  SelLayer[0].Checked := True;
end;

procedure SetResize(Sender: TObject);
var
  l: Integer;
begin
  case Sender of
    MapFrm: begin
      MapPnl.Width := MapFrm.ClientWidth - 20;
      MapPnl.Height := MapFrm.ClientHeight - 20;
      MapScb.Width := MapPnl.Width;
      MapScb.Height := MapPnl.Height;
    end;
    ToolFrm: begin
      ToolPnl.Width := ToolFrm.ClientWidth - 10;
      ToolPnl.Height := ToolFrm.ClientHeight - 30;
      ToolScb.Width := ToolPnl.Width;
      ToolScb.Height := ToolPnl.Height - 64;
      for l := 0 to MainMap.Size.l - 1 do
      begin
        SelLayer[l].Top := ToolPnl.Height - 48;
        VisLayer[l].Top := ToolPnl.Height - 32;
      end;
      SelTile.Vis.Top := ToolPnl.Height - 48;
      SelTile.Vis.Left := 10;
    end;
  end;
end;

procedure SetupForm; forward;

procedure ShowMapForm;
begin
  MapFrm.ShowModal;
end;

procedure ShowToolForm;
begin
  ToolFrm.Show;
end;

procedure LaunchForm;
var
  v: TVariantArray;
begin
  v := [];
  ThreadSafeCall('SetupForm', v);
  ThreadSafeCall('ShowMapForm', v);
end;

procedure LaunchTool(Sender: TObject);
var
  v: TVariantArray;
begin
  v := [];
  ThreadSafeCall('ShowToolForm', v);
end;

procedure SetupForm;
var
  x, y: Integer;
begin
  GetClientDimensions(x, y);

  MapFrm := CreateForm;
  ToolFrm := CreateForm;
  MainMnu := TMainMenu.Create(MapFrm);
  FileMnu := TMenuItem.Create(MapFrm);
  NewMnu := TMenuItem.Create(MapFrm);
  OpenMnu := TMenuItem.Create(MapFrm);
  SaveMnu := TMenuItem.Create(MapFrm);
  RandMnu := TMenuItem.Create(MapFrm);
  OptionMnu := TMenuItem.Create(MapFrm);
  ToolMnu := TMenuItem.Create(MapFrm);
  PropertyMnu := TMenuItem.Create(MapFrm);
  dlgOpen := TOpenDialog.Create(MapFrm);
  dlgSave := TSaveDialog.Create(MapFrm);
  MapPnl := TPanel.Create(MapFrm);
  MapScb := TScrollBox.Create(MapPnl);
  MapImg := TImage.Create(MapScb);
  ToolPnl := TPanel.Create(ToolFrm);
  ToolScb := TScrollBox.Create(ToolPnl);
  ToolImg := TImage.Create(ToolScb);
  PageControl := TPageControl.Create(ToolFrm);
  SelTile.Vis := TImage.Create(ToolPnl);

  MapPnl.Parent := MapFrm;
  MapScb.Parent := MapPnl;
  MapImg.Parent := MapScb;
  ToolPnl.Parent := ToolFrm;
  ToolScb.Parent := ToolPnl;
  ToolImg.Parent := ToolScb;
  PageControl.Parent := ToolFrm;
  SelTile.Vis.Parent := ToolPnl;

  FileMnu.Caption := 'File';
  OptionMnu.Caption := 'Options';
  MainMnu.Items.Add(FileMnu);
  MainMnu.Items.Add(OptionMnu);

  NewMnu.Caption := 'New map';
  NewMnu.OnClick := @MenuActions;
  OpenMnu.Caption := 'Open map';
  OpenMnu.OnClick := @MenuActions;
  SaveMnu.Caption := 'Save map';
  SaveMnu.OnClick := @MenuActions;
  RandMnu.Caption := 'Random map';
  RandMnu.OnClick := @MenuActions;
  MainMnu.Items.Items[0].Add(NewMnu);
  MainMnu.Items.Items[0].Add(OpenMnu);
  MainMnu.Items.Items[0].Add(SaveMnu);
  MainMnu.Items.Items[0].Add(RandMnu);

  ToolMnu.Caption := 'Show Tools';
  ToolMnu.OnCLick := @MenuActions;
  PropertyMnu.Caption := 'Map properties';
  PropertyMnu.OnClick := @MenuActions;
  MainMnu.Items.Items[1].Add(ToolMnu);
  MainMnu.Items.Items[1].Add(PropertyMnu);
  
  dlgOpen.InitialDir := MapPath;
  dlgOpen.Filter := 'mixmap files|*.mixmap';
  
  dlgSave.InitialDir := MapPath;
  dlgSave.Filter := 'mixmap files|*.mixmap';

  MapPnl.Width := 320;
  MapPnl.Height := 320;
  MapPnl.Left := 10;
  MapPnl.Top := 10;

  MapScb.Width := MapPnl.Width;
  MapScb.Height := MapPnl.Height;

  MapImg.Left := 0;
  MapImg.Top := 0;
  MapImg.OnMouseDown := @SetTilesDown;
  MapImg.OnMouseUp := @SetTilesUp;

  PageControl.Align := alTop;
  PageControl.Height := 20;

  ToolPnl.Height := MapPnl.Height - 50;
  ToolPnl.Left := 5;
  ToolPnl.Top := 25;

  ToolScb.Height := ToolPnl.Height - 64;

  LoadTileSheets;

  SelTile.Vis.Width := 32;
  SelTile.Vis.Height := 32;

  MapFrm.ClientWidth := MapPnl.Width + 5;
  MapFrm.ClientHeight := MapPnl.Height + 5;
  MapFrm.Left := (x - MapFrm.ClientWidth) div 2;
  MapFrm.Top := (y - MapFrm.ClientHeight) div 2;
  MapFrm.Caption := 'Mixster''s Map Editor';
  MapFrm.Color := clBtnFace;
  MapFrm.Font.Color := clWindowText;
  MapFrm.Font.Height := -11;
  MapFrm.Font.Name := 'MS Sans Serif';
  MapFrm.Font.Style := [];
  MapFrm.Visible := False;
  MapFrm.PixelsPerInch := 96;
  MapFrm.OnResize := @SetResize;
  MapFrm.OnPaint := @LaunchTool;

  ToolFrm.ClientWidth := ToolPnl.Width - 5;
  ToolFrm.ClientHeight := ToolPnl.Height + 15;
  ToolFrm.Left := MapFrm.Left + MapFrm.Width;
  ToolFrm.Top := MapFrm.Top;
  ToolFrm.Caption := 'Tools';
  ToolFrm.Color := clBtnFace;
  ToolFrm.Font.Color := clWindowText;
  ToolFrm.Font.Height := -11;
  ToolFrm.Font.Name := 'MS Sans Serif';
  ToolFrm.Font.Style := [];
  ToolFrm.Visible := False;
  ToolFrm.PixelsPerInch := 96;
  ToolFrm.OnResize := @SetResize;

  NewMapDNA;
  PaintMap;
end;


begin
  GfxPath := ScriptPath + 'gfx\';
  MapPath := ScriptPath + 'Maps\';
  LaunchForm;
  FreeForm(ToolFrm);
  FreeForm(MapFrm);
end.

Go to options then map properties and put 5 for the first Readln, 25 for the second and 25 for the last. Resize the 'map' window and choose a tile and place it over the entire map for the error. The error occurs in the PaintTiles procedure and PaintMap (if the map size is around 5 x 40+ x 40+) where Buffer is drawn onto MapImg (atleast, I'm pretty sure there).
Edit: Debugged it and it's in the main drawing loop (for y := y1 to y2 do), so I'm guessing it's happening with tempBmp being drawn onto Buffer.
Edit2: And it's "fixed" - for some reason it's RotateBitmap that crashes it, so I guess I'm gonna have to go bug Freddy with it :)

From: mixster
Good luck understanding most of it :)

Your not talking to noobs. Were all srl members here.

I know, but it's a complex form and a few other people have had a look and they didn't really get it at all, not to mention I have good standards but I tend to over script a lot of stuff and throw a load of extra things in :) (I didn't mean it disrespectfully at all).

So… You're drawing a bitmap during startup? For a pokemon like scrolling game?

Actually, it's a map editor, so not really a game. It does some initial drawing then dynamic drawing from then onwards, but I solved the problem anyway as it seems to be an issue with RotateBitmap, so by adapting the way my painting procedures rotate images, I managed to side step the problem quite nicely :)
Hopefully I'll have it finished by the end of next week/this week (depending on if you read it Sunday night or Monday onwards), but I've got some stuff going on so it might be a while :(

And… This is in SCAR?

I can't possibly imagine why you would want this done in SCAR. Unless you're in cahoots with SB100.

It was originally in Delphi and I was doing it to help a friend who was getting pissed off with a map editor, won't mention any names *cough* RPGMakerXP *cough* and decided to port it into Scar when SB mentioned his Pokemon game, though I was thinking about it anyway after History's start on a Scar MMORPG :)

I've had this problem before to, it occurred after loading thousands of images.. Win ran out of handles :p

lol, I haven't tested the limits with the fix, but it can manage 12,500 tiles without rotatebitmap (I think it doesn't free a bitmap or something), but with it, it failed at around 1,240 which just wasn't cool. Hopefully I won't run into that problem though as I only load them 1 at a time and write them onto a regular bitmap, so as long as there's enough memory to hold it, I should be ok :)
I'll go test it now quickly though and see how much it can handle (btw, it's the old version above so it will crash at a small map, roughly 5 x 25 x 25).
Edit: Can make a blank map of 10 x 100 x 100 (100000 tiles in 35781 ms), yay better working version.

From: mixster
lol, I haven't tested the limits with the fix, but it can manage 12,500 tiles without rotatebitmap (I think it doesn't free a bitmap or something), but with it, it failed at around 1,240 which just wasn't cool. Hopefully I won't run into that problem though as I only load them 1 at a time and write them onto a regular bitmap, so as long as there's enough memory to hold it, I should be ok :)
I'll go test it now quickly though and see how much it can handle (btw, it's the old version above so it will crash at a small map, roughly 5 x 25 x 25).
Edit: Can make a blank map of 10 x 100 x 100 (100000 tiles in 35781 ms), yay better working version.

Ouch, try this if you want to kinda "crash" scar :p.

program Hoi;
begin
  Repeat
    Try
      BitmapFromString(1,1,'');
    except
      Writeln('crashed xD');
    end;
  until false;
end.

That script owns - it uses up 50% of my CPU and takes up about 2mb more of my virtual memory every second (got it up past FF's VM after running for just under a minute). What's even more annoying is it gets to a point, spams crashed XD then just gives me a crap load of 'out of memory' and 'canvas doesn't allow drawing' etc. errors :(
I think you need to post it in the free for all section and see how many newbies run it :)
Edit: and 100 x 100 x 10 is roughly the highest it can reliably make - it fails at 200 x 200 x 10 and can get a bit crashy with 150 x 150 x 10. Good news is that most maps will only need about 3 layers, so that should get around 300 x 300, unless Scar doesn't want to work that way :)

If this is a map for a 3d map editor, it will phail.

It's a 2d map, just supports layers so you don't have to have millions of different tiles e.g. you can have a load of different terrains like rock, snow and grass then only have 1 set of signs that can be placed on top of all 3 terrains. After I finished this map editor, I'll work on a 3d one :) (Not really, as it would fail miserably, if it did work, it would take for ever to load and paint).