SRL Archive - SRL Snippets

Hey! I just want to show you, how you can serialize the array of TMufasaBitmap. With this trick you can use your array as resource in script, without strings, etc. Just make the resource file with your bitmaps, and spread it with a script. It helps to write more successful AutoUpdate. Simply update the resource file than the entire script. This method is suitable for any type of data.

Requirements: Lape.

program new;

const
 Path = 'D:\bmptest.file';

var
  BitmapArr: array of TMufasaBitmap;
  ReadedBitmaps: array of TMufasaBitmap;

Procedure InitBitmaps;
var
 i,len: integer;
begin
 SetLength(BitmapArr,3);
 len:=Length(BitmapArr);

 for I:=0 to len - 1 do
  begin
   case i of
    0:
     begin
     BitmapArr[i]:=GetMufasaBitmap(BitmapFromString(10, 10, 'meJwztnE1tfMwBpIOnowMDCUlNY' +
        'WFVVlZRX39M4FcoDgEAdllZXVA2dy88rS03HnzVkFkgbpMHdwgsvk' +
        'FlRkZ+ZMmzQVyFRQMrJy8IWZWVDQAzczOKU1JyV68eD1EFq4RYiZQ' +
        '47TpiyBSEFkgm9MqFIhmzlrW2TVl2fJNEFmIYyBScAVYNUIQr0cO3' +
        'D1AhFUKUxZZCuxUEAIANwhKdQ=='));
     end;
    1:
     begin
     BitmapArr[i]:=GetMufasaBitmap(BitmapFromString(7, 13, 'meJwL6F8f0L9eNqTcNq3VOqUJggL' +
        'AgnBxiBRcBKLGKrEeiGTDq0AooAjCBSIttyizqDKgiEV8jZ5fGhwB' +
        'BaW8s6U8MkwjiiDIODQfpBKsXcovH6gegoDKkB0AsQuoDFMQUyUQi' +
        'TvHYwoyMjDABYEILgg3FqgSohgA9ylm1w=='));
     end;
    2:
     begin
     BitmapArr[i]:=GetMufasaBitmap(BitmapFromString(9, 10, 'meJxrWbypZfEmHuFsCOIwCoEjXOJ' +
        'wQTQphIhwGgQBTcAqDpFCNh/Ibl6wrmPh2s6lm4EILsXAYQzhAmWB' +
        'CMjuWrFNQG4WUBwiBUFAKYiBECkgA6ILGQGl0ETg2uGKAZqlZzY='));
     end;
   end;
  end;

end;

procedure SaveBitmaps();
var
  FStm: TFileStream;
  i: Integer;
  b: TMufasaBitmap;
  Len: integer;
  j, y, w, h: integer;
  Size: integer;
begin
  FStm.Init(Path, $FF00 or $0001 or $0020);
  try
    len := Length(BitmapArr);
    FStm.WriteBuffer(len, sizeof(integer));
    for i := 0 to len - 1 do
    begin
      b := BitmapArr[i];
      w := b.GetWidth();
      h := b.GetHeight();
      FSTM.WriteBuffer(w, sizeof(integer));
      FSTM.WriteBuffer(h, sizeof(integer));
      Size := w * h * SizeOf(TRGB32);
      WriteLn(IntToStr(size));
      FSTM.WriteBuffer(size, sizeof(integer));
      for j := 0 to w - 1 do
        for y := 0 to h - 1 do
        begin
          FSTM.WriteBuffer(B.GetPixel(j, y), sizeof(integer));
        end;
    end;
  finally
    FSTM.free;
  end;
end;

procedure LoadBitmaps();
var
  FStm: TFileStream;
  i: Integer;
  Len: integer;
  j, y, acolor: integer;
  Size: integer;
  w, h: integer;
begin
  FStm.init(Path, $0000 or $0020);
  try
    FSTM.ReadBuffer(Len, SizeOf(Integer));
    WriteLn('Bitmaps count: ' + IntToStr(len));
    SetLength(ReadedBitmaps, Len);
    for i := 0 to len - 1 do
    begin
      FSTM.ReadBuffer(W, SizeOf(Integer));
      WriteLn('Current bitmap width: ' + IntToStr(w));
      FSTM.ReadBuffer(H, SizeOf(Integer));
      WriteLn('Current bitmap height: ' + IntToStr(H));
      FSTM.ReadBuffer(Size, SizeOf(Integer));
      WriteLn('Current bitmap size: ' + IntToStr(Size));
      ReadedBitmaps[i].init;
      ReadedBitmaps[i].SetSize(W, H);
      for j := 0 to w - 1 do
        for y := 0 to h - 1 do
        begin
          FSTM.ReadBuffer(acolor, sizeof(integer));
          ReadedBitmaps[i].SetPixel(j, y, acolor);
        end;
    end;
  finally
    FSTM.Free;
  end;
end;

function TestBitmaps(): boolean;
var
  i: integer;
  str1, str2: string;
begin
  result := true;
  for i := 0 to 2 do
  begin
    if (BitmapArr[i].GetWidth() <> ReadedBitmaps[i].GetWidth()) or (BitmapArr[i].GetHeight() <> ReadedBitmaps[i].GetHeight()) then
      result := false;
    str1 := BitmapArr[i].ToString();
    str2 := ReadedBitmaps[i].ToString();
    if (LevDistance(str1, str2) > 0) then
      result := false;
  end;
end;

procedure FreeBitmaps;
var
  i: integer;
begin
  for i := 0 to 2 do
  begin
    FreeBitmap(i);
    ReadedBitmaps[i].free;
  end;
end;

begin
  InitBitmaps;
  SaveBitmaps();
  LoadBitmaps();
  if not TestBitmaps then
    WriteLn('Bitmaps not equal!')
  else
    WriteLn('Bitmaps are equal! Test passed!');
  FreeBitmaps();
end. 

Testing output:

Compiled successfully in 203 ms.
1600
1456
1440
Bitmaps count: 3
Current bitmap width: 10
Current bitmap height: 10
Current bitmap size: 1600
Current bitmap width: 7
Current bitmap height: 13
Current bitmap size: 1456
Current bitmap width: 9
Current bitmap height: 10
Current bitmap size: 1440
Bitmaps are equal! Test passed!
Successfully executed.
Compiled successfully in 203 ms.
InitBitmaps
SaveBitmaps
LoadBitmaps
TestBitmaps
FreeBitmaps
Compiled successfully in 187 ms.
Compiled successfully in 203 ms.
1600
1456
1440
Bitmaps count: 3
Current bitmap width: 10
Current bitmap height: 10
Current bitmap size: 1600
Current bitmap width: 7
Current bitmap height: 13
Current bitmap size: 1456
Current bitmap width: 9
Current bitmap height: 10
Current bitmap size: 1440
Bitmaps are equal! Test passed!
Successfully executed.
Successfully saved: C:\Simba\Scripts\BinarySerializationMufasaBitmaps.simba
Compiled successfully in 203 ms.
1600
1456
1440
Bitmaps count: 3
Current bitmap width: 10
Current bitmap height: 10
Current bitmap size: 1600
Current bitmap width: 7
Current bitmap height: 13
Current bitmap size: 1456
Current bitmap width: 9
Current bitmap height: 10
Current bitmap size: 1440
Bitmaps are equal! Test passed!
Successfully executed.

Well, this is all. With a little imagination, your scripts will be better.

Cheers,
Cynic.