ビットマップとテキストを１つのファイルに保存したいのですが (ID:36430)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

意外と簡単に実装可能です。
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure LoadTBStream(var aStream:TStream; var Txt:string; var Bmp:TBitmap);
var
  size:Integer;
begin
  aStream.Position:=0;
  aStream.Read(size,SizeOf(Integer));
  SetLength(Txt,size div SizeOf(Char));
  aStream.read(Txt[1], size-1);
  Bmp.LoadFromStream(aStream);
end;

procedure SaveTBStream(var aStream:TStream; var Txt:string; var Bmp:TBitmap);
var
  size:Integer;
begin
  aStream.Position:=0;
  size := Length(Txt) * SizeOf(Char);
  aStream.Write(size, SizeOf(Integer));
  aStream.Write(Txt[1],size-1);
  Bmp.SaveToStream(aStream);
end;

procedure LoadTB(FileName:string; var Txt:string; var Bmp:TBitmap);
var
  aStream:TMemoryStream;
begin
  aStream := TMemoryStream.Create;
  aStream.LoadFromFile(FileName);
  LoadTBStream(TStream(aStream), Txt, Bmp);
  aStream.Free;
end;

procedure SaveTB(FileName:string; var Txt:string; var Bmp:TBitmap);
var
  aStream:TMemoryStream;
begin
  aStream := TMemoryStream.Create;
  SaveTBStream(TStream(aStream), Txt, Bmp);
  aStream.SaveToFile(FileName);
  aStream.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp:TBitmap;
  txt:string;
begin
  bmp := TBitmap.Create;
  bmp.LoadFromFile('test.bmp');
  txt := Memo1.Text;
  SaveTB('test.tbf',txt,bmp);
  bmp.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  bmp:TBitmap;
  txt:string;
begin
  bmp := TBitmap.Create;
  LoadTB('test.tbf',txt,bmp);
  Canvas.Draw(0,0,bmp);
  Memo1.Text:=txt;
  bmp.Free;
end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る