fdocfile.pas

是一个delphi的流程制作软件

unit fDocFile;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls
  ,ActiveX // IStream, IStorage
  ,AxCtrls, ExtCtrls // TOleStream
  ;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    Memo2: TMemo;
    Label2: TLabel;
    Label3: TLabel;
    OpenDialog2: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure SaveFile(FileName : WideString);
    procedure LoadFile(FileName : WideString);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
     with SaveDialog1
     do
       begin
       if Execute
       then
           SaveFile(FileName);
       end;
end;

procedure TForm1.SaveFile(FileName : WideString);
var Hr          : HResult;
    Stream      : IStream;
    OleStream   : TOleStream;
    RootStorage : IStorage;
    SubStorage  : IStorage;
    STGM        : longint;
begin
     STGM := STGM_CREATE or STGM_READWRITE or STGM_DIRECT or STGM_SHARE_EXCLUSIVE;
     Hr := StgCreateDocFile(PWideChar(FileName), STGM, 0, RootStorage);
     if not SUCCEEDED(Hr)
     then
         Exit;

     //**********
     // TEXT
     //**********
     Hr := RootStorage.CreateStorage('TEXT', STGM,0,0,SubStorage);
     if not SUCCEEDED(Hr)
     then
         Exit;
     //Save Memo1
     Hr := SubStorage.CreateStream('SomeText', STGM,0,0,Stream);
     if not SUCCEEDED(Hr)
     then
         Exit;
     OleStream := TOleStream.Create(Stream);
     Memo1.Lines.SaveToStream(OleStream);
     OleStream.Free;

     //**********
     // IMAGE
     //**********
     Hr := RootStorage.CreateStorage('IMAGE', STGM,0,0,SubStorage);
     if not SUCCEEDED(Hr)
     then
         Exit;
     //Save Image1
     Hr := SubStorage.CreateStream('Bitmap', STGM,0,0,Stream);
     if not SUCCEEDED(Hr)
     then
         Exit;
     OleStream := TOleStream.Create(Stream);
     Image1.Picture.Bitmap.SaveToStream(OleStream);
     OleStream.Free;
     //Save Memo2
     Hr := SubStorage.CreateStream('Comment', STGM,0,0,Stream);
     if not SUCCEEDED(Hr)
     then
         Exit;
     OleStream := TOleStream.Create(Stream);
     Memo2.Lines.SaveToStream(OleStream);
     OleStream.Free;
     //
     showmessage('Saved to file ' + FileName);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
     with OpenDialog2
     do
       begin
       if Execute
       then
           LoadFile(FileName);
       end;
end;

procedure TForm1.LoadFile(FileName : WideString);
var Hr          : HResult;
    Stream      : IStream;
    OleStream   : TOleStream;
    RootStorage : IStorage;
    SubStorage  : IStorage;
    STGM        : longint;
begin
     if StgIsStorageFile(PWideChar(FileName)) <> S_OK
     then
         begin
         ShowMessage(FileName + ' is not a DocFile');
         Exit;
         end;
     STGM := STGM_READWRITE or STGM_DIRECT or STGM_SHARE_EXCLUSIVE;
     Hr := StgOpenStorage(PWideChar(FileName), nil, STGM, nil, 0, RootStorage);
     if not SUCCEEDED(Hr)
     then
         Exit;
     //**********
     // TEXT
     //**********
     Hr := RootStorage.OpenStorage('TEXT', nil, STGM, nil,0, SubStorage);
     if not SUCCEEDED(Hr)
     then
         Exit;
     //Memo1
     Hr := SubStorage.OpenStream('SomeText', nil, STGM, 0, Stream);
     if not SUCCEEDED(Hr)
     then
         Exit;
     OleStream := TOleStream.Create(Stream);
     if(OleStream.Size > 0)
     then
         Memo1.lines.LoadFromStream(OleStream);
     OleStream.Free;

     //**********
     // IMAGE
     //**********
     Hr := RootStorage.OpenStorage('IMAGE', nil, STGM, nil,0, SubStorage);
     if not SUCCEEDED(Hr)
     then
         Exit;
     //Image1
     Hr := SubStorage.OpenStream('BITMAP', nil, STGM, 0, Stream);
     if not SUCCEEDED(Hr)
     then
         Exit;
     OleStream := TOleStream.Create(Stream);
     if(OleStream.Size > 0)
     then
         Image1.Picture.Bitmap.LoadFromStream(OleStream);
     OleStream.Free;
     //Memo2
     Hr := SubStorage.OpenStream('COMMENT', nil, STGM, 0, Stream);
     if not SUCCEEDED(Hr)
     then
         Exit;
     OleStream := TOleStream.Create(Stream);
     if(OleStream.Size > 0)
     then
         Memo2.lines.LoadFromStream(OleStream);
     OleStream.Free;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
     with OpenDialog1
     do
       begin
       if Execute
       then
           Image1.Picture.Bitmap.LoadFromFile(FileName);
       end;
end;

end.