main.pas

一个经典的读写Excel的控件

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, XLSReadWriteII2, EscherTypes2, ExtCtrls, jpeg, ZLib;

type
  TfrmMain = class(TForm)
    XLS: TXLSReadWriteII2;
    Button1: TButton;
    Label1: TLabel;
    edFilename: TEdit;
    Button2: TButton;
    dlgOpen: TOpenDialog;
    lbPictures: TListBox;
    Button3: TButton;
    Image: TImage;
    Label2: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure lbPicturesDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FExePath: string;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.Button2Click(Sender: TObject);
begin
  dlgOpen.FileName := edFilename.Text;
  if dlgOpen.Execute then
    edFilename.Text := dlgOpen.FileName;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
var
  i: integer;
  S: string;
begin
  XLS.Filename := edFilename.Text;
  Screen.Cursor := crHourGlass;
  try
    XLS.Read;

    lbPictures.Clear;
    for i := 0 to XLS.MSOPictures.Count - 1 do begin
      S := XLS.MSOPictures[i].Filename;
      if S = '' then
        lbPictures.Items.Add('Picture ' + IntToStr(i + 1) + ' (' + TMSOBlipTypeStr[Integer(XLS.MSOPictures[i].PictType)] + ')')
      else
        lbPictures.Items.Add(S);
    end;

  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TfrmMain.Button3Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.lbPicturesDblClick(Sender: TObject);
var
  i,Sz: integer;
  S: string;
  Buf: Pointer;
  Stream: TFileStream;
begin
  i := lbPictures.ItemIndex;
  if i < 0 then
    Exit;
  S := FExePath + 'temp.' + TMSOBlipTypeStr[Integer(XLS.MSOPictures[i].PictType)];
  if XLS.MSOPictures[i].Compressed then begin
    DecompressBuf(XLS.MSOPictures[i].PictureBuf,XLS.MSOPictures[i].PictureSize,XLS.MSOPictures[i].CompressedSize,Buf,Sz);
    Stream := TFileStream.Create(S,fmCreate);
    try
      Stream.Write(Buf,Sz);
    finally
      Stream.Free;
    end;
  end
  else
    XLS.MSOPictures[i].SaveToFile(S);
  Image.Picture.LoadFromFile(S);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FExePath := ExtractFilePath(Application.ExeName);
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
  SR: TSearchRec;
begin
  if FindFirst(FExePath + 'temp.*',0,SR) = 0 then begin
    repeat
      DeleteFile(FExePath + SR.Name);
    until (FindNext(SR) <> 0);
    FindClose(SR);
  end;
end;

end.