unit1.pas

图象处理的一些相关内容 不是很难的,实现简单,希望对大家有帮助

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls,FileCtrl,jpeg,activex,ComObj,axctrls;


const PassWordLength=12;
type PassWordString=string[PassWordLength];

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    ButtonSelectDir: TButton;
    GroupBox2: TGroupBox;
    Edit2: TEdit;
    ButtonSetOutFile: TButton;
    ButtonBeginAddPackage: TButton;
    Button6: TButton;
    ProgressBar1: TProgressBar;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    CheckBox1: TCheckBox;
    Edit3: TEdit;
    Edit4: TEdit;
    SaveDialog1: TSaveDialog;
    GroupBox4: TGroupBox;
    Edit7: TEdit;
    ButtonOpenSSPFile: TButton;
    GroupBox5: TGroupBox;
    Edit6: TEdit;
    ButtonSelectOutPutDir: TButton;
    ButtonBeginExtractPackage: TButton;
    Button8: TButton;
    ProgressBar2: TProgressBar;
    OpenDialog1: TOpenDialog;
    procedure ButtonSelectDirClick(Sender: TObject);
    procedure ButtonSetOutFileClick(Sender: TObject);
    procedure ButtonBeginAddPackageClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure ButtonOpenSSPFileClick(Sender: TObject);
    procedure ButtonSelectOutPutDirClick(Sender: TObject);
    procedure ButtonBeginExtractPackageClick(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    FStructureStorageFileName:string;
    FImageFileList:TStringList;
    FOriginalBmp,FThumbBmp:Tbitmap;
    FThumbJpg,FOriginalJpeg:TJpegImage;

    { Private declarations }
  public
    procedure SearchImageFile(dir:string);
    procedure CreateStructureStorageFile(AStructureStorageFileName:string;
      AStrPassWord:PassWordString;ATotalFiles:integer);
    procedure ConvertImageToThumb(AImageFileName:string;AThumbBmp:Tbitmap);
    procedure AddSmallImage(AStructureStorageFileName:string;
      ASmallImageFileName:string;ABmp:Tbitmap);
    procedure AddLargeImage(AStructureStorageFileName:string;
      ALargeImageFileName:string);
    procedure ExtractSSPFile(SSPFileName:string;OutPutDir:string;
      AProgressBar:TProgressBar);

    function  GetTotalImageFileNumInSSP(SSPFileName:string):integer;
    { Public declarations }
  end;
  function  IsJpgFile(const FileName:string):boolean;
  procedure JpgToBmp(const JpgFileName:string;AJpg:TJpegImage;Abmp:Tbitmap);
  procedure DrawPanel(canvas:TCanvas;Left,Top,Width,Height:integer;PanelType:integer);

const
  RaisedPanel=1;
  LoweredPanel=2;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.DFM}


//仅从扩展名上来判断是否是jpg格式的文件
function  IsJpgFile(const FileName:string):boolean;
begin
  result:=(LowerCase( ExtractFileExt(FileName))='.jpg') or (LowerCase( ExtractFileExt(FileName))='.jpeg');
end;


//转换jpg到bmp
procedure JpgToBmp(const JpgFileName:string;AJpg:TJpegImage;Abmp:Tbitmap);
begin
  try
    AJpg.LoadFromFile(JpgFileName);
    Abmp.Assign(AJpg);
  finally
  end;
end;

//在canvas上画一个Panel
procedure DrawPanel(canvas:TCanvas;Left,Top,Width,Height:integer;PanelType:integer);
var
  Right,Bottom:integer;
  LeftTopColor,RightBottomColor:TColor;
begin
  //凸起的panel
  if PanelType=RaisedPanel  then
  begin
    LeftTopColor:=clwhite;
    RightBottomColor:=clgray;
  end
  else //凹下去的panel
  begin

    LeftTopColor:=clgray;
    RightBottomColor:=clwhite;
  end;
      Right:=Left+width;
      Bottom:=Top+Height;

      Canvas.Pen.Width:=1;
      Canvas.Pen.Color:=LeftTopColor;

      Canvas.MoveTo(Right,Top);
      Canvas.lineTo(Left,Top);

      Canvas.LineTo(Left,bottom);

      Canvas.Pen.Color:=RightBottomColor;

      Canvas.lineTo(Right,Bottom);
      Canvas.lineTo(Right,Top);
end;


function IsRequrePassWord(
  AStructureStorageFileName: string): boolean;
var
  stgRoot:IStorage;
  stgPassWord:IStorage;

  stmPassWord:IStream;

  ReadPassWord:PassWordString;

  ReadChars:integer;
begin
  result:=false;
  ReadPassWord:='            ';    //12个空格！

  //打开结构化存储文件，返回根存储stgRoot
  OleCheck(StgOpenStorage(StringToOleStr(AStructureStorageFileName),nil,
    STGM_READWRITE or STGM_SHARE_EXCLUSIVE,nil,0,stgRoot));



  //在根存储stgRoot下打开子存储stgPassWord
  OleCheck(stgRoot.OpenStorage('PassWord',nil, STGM_READWRITE or
  STGM_SHARE_EXCLUSIVE,nil,0, stgPassWord));


  OleCheck(stgPassWord.OpenStream('PassWordValue',nil,STGM_READWRITE or
    STGM_SHARE_EXCLUSIVE,0,stmPassWord));

  stmPassWord.Read(@ReadPassWord[1],PassWordLength,@ReadChars);

  result:=not (trim(ReadPassWord)='NoPassWord');

end;

function IsCorrectPassWord(AStructureStorageFileName: string;
  APassWord: PassWordString):boolean;
var
  stgRoot:IStorage;
  stgPassWord:IStorage;

  stmPassWord:IStream;

  ReadPassWord:PassWordString;

  ReadChars:integer;
begin
  result:=false;
  ReadPassWord:='            ';    //12个空格！

  //打开结构化存储文件，返回根存储stgRoot
  OleCheck(StgOpenStorage(StringToOleStr(AStructureStorageFileName),nil,
    STGM_READWRITE or STGM_SHARE_EXCLUSIVE,nil,0,stgRoot));



  //在根存储stgRoot下打开子存储stgSmallImage
  OleCheck(stgRoot.OpenStorage('PassWord',nil, STGM_READWRITE or
  STGM_SHARE_EXCLUSIVE,nil,0, stgPassWord));


  OleCheck(stgPassWord.OpenStream('PassWordValue',nil,STGM_READWRITE or
    STGM_SHARE_EXCLUSIVE,0,stmPassWord));

  stmPassWord.Read(@ReadPassWord[1],PassWordLength,@ReadChars);

  //showmessage('true :'+ReadPassWord);

  //showmessage('length:'+inttostr(length(ReadPassWord)));


  //showmessage('2true :'+APassWord);

  //showmessage('2length:'+inttostr(length(APassWord)));

  result:=(trim(ReadPassWord)=trim(APassWord));

end;


procedure TForm1.ButtonSelectDirClick(Sender: TObject);
var
  dir:string;
begin
  dir:='c:\';
  if SelectDirectory( dir,[sdAllowCreate, sdPerformCreate, sdPrompt],0) then
  edit1.Text:=dir;
end;

procedure TForm1.ButtonSetOutFileClick(Sender: TObject);
begin
  if SaveDialog1.Execute then
  begin
    if lowercase(ExtractFileExt(SaveDialog1.FileName))<>'.ssp' then
    begin
      if FileExists(SaveDialog1.FileName+'.ssp') then
        if MessageDlg('文件：'+SaveDialog1.FileName+'.ssp'+'已经存在，是否覆盖？',mtInformation,[mbYes,MbNo],0)=mrYes then
            edit2.Text:=SaveDialog1.FileName+'.ssp'
          else
            exit
      else
        edit2.Text:=SaveDialog1.FileName+'.ssp'
    end
    else
    begin
      if FileExists(SaveDialog1.FileName) then
        if MessageDlg('文件：'+SaveDialog1.FileName+'已经存在，是否覆盖？',mtInformation,[mbYes,MbNo],0)=mrYes then
            edit2.Text:=SaveDialog1.FileName
          else
            exit
      else
        edit2.Text:=SaveDialog1.FileName

    end;

  end;

end;

procedure TForm1.ButtonBeginAddPackageClick(Sender: TObject);
var
  i:integer;
  ImageFileName:string;
  StrPassWord:string;

begin

  if trim(edit3.Text)<>trim(edit4.Text) then
  begin
    showmessage('您两次输入的密码不一致！');
    exit;
  end;

  if (not DirectoryExists(edit1.text)) then
  begin
    showmessage('目录'+edit1.text+'不存在！');
    exit;
  end;

  if not DirectoryExists(ExtractFileDir(edit2.text)) then
  begin
    showmessage('目录'+ExtractFileDir(edit2.text)+'不存在！');
    exit;
  end;


  if CheckBox1.Checked and (trim(edit4.Text)='') then
  begin
    showmessage('密码不能为空！');
    exit;
  end;
  StrPassWord:=edit4.Text;

  if  not CheckBox1.Checked then
    StrPassWord:='NoPassWord';

  FStructureStorageFileName:=edit2.Text;

  SearchImageFile(edit1.Text);

  if FImageFileList.Count=0 then
  begin
    showmessage('在目录'+edit1.Text+'下未发现任何图片文件！');
    exit;
  end;

  CreateStructureStorageFile(FStructureStorageFileName,StrPassWord,FImageFileList.Count);


  screen.Cursor:=crHourGlass;
  ProgressBar1.Visible:=true;
  ProgressBar1.Max:=FImageFileList.Count-1;

  try
    for i:=0 to FImageFileList.Count-1 do
    begin
      ImageFileName:=FImageFileList[i];
      ConvertImageToThumb(ImageFileName,FThumbBmp);
      AddSmallImage(FStructureStorageFileName,ExtractFileName(ImageFileName), FThumbBmp);
      AddLargeImage(FStructureStorageFileName,ImageFileName);
      ProgressBar1.Position:=i;
    end;
  finally
  end;
  ProgressBar1.Visible:=false;
  screen.Cursor:=crDefault;
  showmessage('打包成功！');

end;

procedure TForm1.SearchImageFile(dir: string);
var
  SearchRec : TSearchRec;
  Attr : integer;
  Found : integer;
  ExtFileName:string;
  temstr:string;

begin
  if dir[length(dir)]='\' then
    delete(dir,length(dir),1);

  temstr:=dir+'\*.*';
  Attr := faAnyFile;
  Found := FindFirst(temstr, Attr, SearchRec);
  while Found = 0 do
  begin
    ExtFileName:=LowerCase(ExtractFileExt(SearchRec.Name));
    if (  (ExtFileName='.bmp') or (ExtFileName='.jpg') or
      (ExtFileName='.jpeg')) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..')
    then
      FImageFileList.Add(dir+'\'+SearchRec.Name);

    Found := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;


procedure TForm1.CreateStructureStorageFile(
  AStructureStorageFileName: string; AStrPassWord: PassWordString;
  ATotalFiles: integer);
var
  stgRoot:IStorage;
  stgPassWord:IStorage;
  stgSmallImage:IStorage;
  stgLargeImage:IStorage;
  stgTotalFiles:IStorage;

  stmPassWord:IStream;
  stmTotalFiles:IStream;

  stmData:IStream;

  stmSmallImage:IStream;
  stmLargeImage:IStream;

  OleStream:Tolestream;
begin

  //创建结构化存储文件，返回根存储stgRoot
  OleCheck(StgCreateDocfile(StringToOleStr(AStructureStorageFileName),
    STGM_CREATE or STGM_READWRITE or STGM_SHARE_EXCLUSIVE,0,stgRoot));

  //在根存储stgRoot下创建子存储stgPassWord
  OleCheck(stgRoot.CreateStorage('PassWord',STGM_CREATE or STGM_READWRITE or
    STGM_SHARE_EXCLUSIVE,0,0, stgPassWord));

  //在子存储stgPassWord下创建流stmPassWord
  OleCheck(stgPassWord.CreateStream('PassWordValue',STGM_CREATE or STGM_READWRITE or
    STGM_SHARE_EXCLUSIVE,0,0,stmPassWord));

  //向流stmPassWord中写入数据
  stmPassWord.Write(@AStrPassWord[1],PassWordLength,nil);



  //在根存储stgRoot下创建子存储stgTotalFiles
  OleCheck(stgRoot.CreateStorage('TotalFiles',STGM_CREATE or STGM_READWRITE or
    STGM_SHARE_EXCLUSIVE,0,0, stgTotalFiles));

  //在子存储stgPassWord下创建流stmPassWord
  OleCheck(stgTotalFiles.CreateStream('TotalFilesValue',STGM_CREATE or STGM_READWRITE or
    STGM_SHARE_EXCLUSIVE,0,0,stmTotalFiles));

  //向流stmPassWord中写入数据
  stmTotalFiles.Write(@ATotalFiles,sizeof(integer),nil);







  //在根存储stgRoot下创建子存储stgSmallImage
  OleCheck(stgRoot.CreateStorage('SmallImage',STGM_CREATE or STGM_READWRITE or