Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Library: Grafik / Sound / Multimedia (https://www.delphipraxis.net/21-library-grafik-sound-multimedia/)
-   -   Delphi Bitmap in ini speichern/aus ini lesen (https://www.delphipraxis.net/49856-bitmap-ini-speichern-aus-ini-lesen.html)

FriFra 17. Jul 2005 03:30


Bitmap in ini speichern/aus ini lesen
 
Heute stand ich vor dem Problem, dass ich zu diversen Profileinträgen in einer ini icons abspeichern wollte. Da ich die icons nicht als externe Dateien ablegen wollte hab ich mir 2 Funktionen für diesen Zweck geschrieben.
Sicher ist das ein Missbrauch von ini-Dateien, aber für kleine 16x16 Images noch vertretbar. Die Funktionen unterstützen jedoch jede Bildgröße.

Schreiben in ini:
Delphi-Quellcode:
  function BitmapToIni(Ini: TMemIniFile; Section, Key: string; bmp: TBitmap):
      boolean;
    procedure CompressStream(sIn, sOut: TStream);
    var
      pIn, pOut: Pointer;
      sizeRead, sizeWrite: integer;
    begin
      pIn := nil;
      pOut := nil;
      try
        getmem(pIn, sIn.size);
        sIn.Position := 0;
        sizeRead := sIn.Read(pIn^, sIn.Size);
        CompressBuf(pIn, sizeRead, pOut, sizeWrite);
        sOut.Write(pOut^, sizeWrite);
      finally
        if pIn <> nil then
          freemem(pIn);
        if pOut <> nil then
          freemem(pOut);
      end;
    end;
    function Encode64(S: string): string;
    const
      Codes64 =
        '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/';
    var
      i: Integer;
      a: Integer;
      x: Integer;
      b: Integer;
    begin
      Result := '';
      a := 0;
      b := 0;
      for i := 1 to Length(s) do
      begin
        x := Ord(s[i]);
        b := b * 256 + x;
        a := a + 8;
        while a >= 6 do
        begin
          a := a - 6;
          x := b div (1 shl a);
          b := b mod (1 shl a);
          Result := Result + Codes64[x + 1];
        end;
      end;
      if a > 0 then
      begin
        x := b shl (6 - a);
        Result := Result + Codes64[x + 1];
      end;
    end;
  var
    n, x, y: integer;
    Tmp: string;
    BitmapStream: TMemoryStream;
    IniStream: TStringStream;
  begin
    BitmapStream := TMemoryStream.Create;
    IniStream := TStringStream.Create('');
    Result := False;
    try
      bmp.SaveToStream(BitmapStream);
      BitmapStream.Position := 0;
      CompressStream(BitmapStream, IniStream);
      IniStream.Position := 0;
      Tmp := Encode64(IniStream.DataString);
      n := 0;
      while Ini.ValueExists(Section, Key + '_' + IntToStr(n)) = True do
      begin
        Ini.DeleteKey(Section, Key + '_' + IntToStr(n));
        Inc(n);
      end;
      n := 0;
      while Tmp <> '' do
      begin
        ini.WriteString(Section, Key + '_' + IntToStr(n), Copy(Tmp, 1, 64));
        Tmp := Copy(Tmp, 65, Length(Tmp));
        Inc(n);
      end;
      Ini.UpdateFile;
      Result := True;
    finally
      BitmapStream.Free;
      IniStream.Free;
    end;
  end;

Auslesen aus ini:
Delphi-Quellcode:
  function BitmapFromIni(Ini: TMemIniFile; Section, Key: string): TBitmap;
    procedure DeCompressStream(sIn, sOut: TStream);
    var
      pIn, pOut: Pointer;
      sizeRead, sizeWrite: integer;
    begin
      pIn := nil;
      pOut := nil;
      try
        getmem(pIn, sIn.size);
        sIn.Position := 0;
        sizeRead := sIn.Read(pIn^, sIn.Size);
        DecompressBuf(pIn, sizeRead, sizeRead, pOut, sizeWrite);
        sOut.Write(pOut^, sizeWrite);
        if pOut <> nil then
          freemem(pOut);
      finally
        if pIn <> nil then
          freemem(pIn);
      end;
    end;
    function Decode64(S: string): string;
    const
      Codes64 =
        '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/';
    var
      i: Integer;
      a: Integer;
      x: Integer;
      b: Integer;
    begin
      Result := '';
      a := 0;
      b := 0;
      for i := 1 to Length(s) do
      begin
        x := Pos(s[i], codes64) - 1;
        if x >= 0 then
        begin
          b := b * 64 + x;
          a := a + 6;
          if a >= 8 then
          begin
            a := a - 8;
            x := b shr a;
            b := b mod (1 shl a);
            x := x mod 256;
            Result := Result + chr(x);
          end;
        end
        else
          Exit;
      end;
    end;
  var
    IniString: string;
    IniStream: TStringStream;
    BitmapStream: TMemoryStream;
    n: integer;
  const
    DEFAULT_BMP =
      'UDfpyZLZOG03Co3M0681A6PaK818GEMHmOaBLoZ2b8A6XWQoCKp/WGC76Fx//qyI7jK/kFHJ6l/xWMni66GN0nQQMFsuCBf+KZ6oVaemfVaN0FN5zQK';
  begin
    IniString := '';
    n := 0;
    while Ini.ValueExists(Section, Key + '_' + IntToStr(n)) = True do
    begin
      IniString := IniString + Ini.ReadString(Section, Key + '_' + IntToStr(n),
        '');
      Inc(n);
    end;
    if IniString = '' then
      IniString := DEFAULT_BMP;
    IniStream := TStringStream.Create(Decode64(IniString));
    BitmapStream := TMemoryStream.Create;
    try
      IniStream.Position := 0;
      try
        DecompressStream(IniStream, BitmapStream);
        BitmapStream.Position := 0;
        Result := TBitmap.Create;
        Result.LoadFromStream(BitmapStream);
      except
        if Result = nil then
        begin
          IniString := DEFAULT_BMP;
          FreeAndNil(IniStream);
          IniStream := TStringStream.Create(Decode64(IniString));
          IniStream.Position := 0;
          DecompressStream(IniStream, BitmapStream);
          BitmapStream.Position := 0;
          Result := TBitmap.Create;
          Result.LoadFromStream(BitmapStream);
        end
        else
        begin
          Result.Width := 16;
          Result.Height := 16;
          Result.Canvas.Brush.Color := clRed;
          Result.Canvas.FillRect(Result.Canvas.ClipRect);
        end;
      end;
    finally
      IniStream.Free;
      BitmapStream.Free;
    end;
  end;
[Edit]Bei der letzten bearbeitung hatte ich versehentlich 2 mal BitmatFromIni kopiert :oops: [/edit]


Alle Zeitangaben in WEZ +1. Es ist jetzt 04:00 Uhr.

Powered by vBulletin® Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2020 by Daniel R. Wolf