bmptoaviunit.pas

灰鸽子VIP1.2经典源代码

unit BmpToAviUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DynamicSkinForm, SkinCtrls, StdCtrls, ExtCtrls,DelphiVid,
  SkinBoxCtrls, Spin, LangFrm;

type
  TBmpToAviForm = class(TLangForm)
    DSF: TspDynamicSkinForm;
    Panel1: TspSkinPanel;
    Label2: TspSkinStdLabel;
    addButton: TspSkinButton;
    DllButton: TspSkinButton;
    OkButton: TspSkinButton;
    Image1: TImage;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    CloseButton: TspSkinButton;
    ListBox1: TspSkinListBox;
    Label1: TspSkinStdLabel;
    SpinEdit1: TSpinEdit;
    procedure addButtonClick(Sender: TObject);
    procedure OkButtonClick(Sender: TObject);
    procedure CloseButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Procedure Log(Ph:String);
    Procedure CreerAvi;
  end;

var
  BmpToAviForm: TBmpToAviForm;
  Fichier:String;

implementation
uses
Main;

{$R *.dfm}

Procedure Err(Ph:String);
Begin
 Beep;
 ShowMessage(Ph);
end;

Procedure TBmpToAviForm.Log(Ph:String);
Begin
 ListBox1.Items.Add(Ph);
End;

Procedure TBmpToAviForm.CreerAvi;
Var
 Reponse : Integer;
 C,C1:LongInt;
 Cp:LongWord;
 PFile1: PAVIFile;
 NewAvi: PAVIStream;
 AviInfo: PAviStreamInfo;
 Image:Pointer;
 InfoSize   : Dword ;
 ImageSize  : Dword ;
 BitmapInfo:PBitmapInfo;
 Procedure Sortie;
 Begin
  FreeMem(BitMapInfo);
  FreeMem(Image);
  Freemem(AviInfo);
 End;
Begin
try
 if SaveDialog1.Execute then
 begin
 AVIFileInit;

 // Ouvre le fichier a traiter New
 Reponse := AVIFileOpen(Pfile1,PChar(SaveDialog1.FileName),OF_WRITE or OF_CREATE,nil);

 if Reponse <> 0 then
  begin
   Sortie;
   Err('Erreur d''ouverture fichier ...');
   AVIFileExit;
   exit;
  end;

 // Declaration des parametres Avi

 GetDIBSizes(Image1.Picture.Bitmap.Handle, InfoSize, ImageSize);
 Image1.Refresh;
 GetMem(BitMapInfo,InfoSize);
 ZeroMemory(BitMapInfo,InfoSize);
 GetMem(Image,ImageSize);
 ZeroMemory(Image,ImageSize);

 GetDIB(Image1.Picture.Bitmap.Handle,Image1.Picture.Bitmap.Palette,BitmapInfo^,Image^);

 Getmem(AviInfo,Sizeof(TAviStreamInfo));
 ZeroMemory(AviInfo,Sizeof(TAviStreamInfo));

 AviInfo^.fccType:=StreamTypeVideo;
 AviInfo^.fccHandler:=Bi_RGB;
 AviInfo^.dwScale:= 1;
 AviInfo^.dwRate:=SpinEdit1.Value ;
 AviInfo^.rcFrame:=Rect(0,0,BitMapInfo^.BmiHeader.BiWidth,BitMapInfo^.BmiHeader.BiHeight);
 AviInfo^.dwSuggestedBufferSize:=ImageSize;

 BitMapInfo^.BmiHeader.BiCompression:=Bi_RGB;

 // Creer le stream video du nouveau fichier AVI New
 Reponse := AVIFileCreateStream(PFile1,NewAvi,AviInfo^);
 if Reponse <> AVIERR_OK then
  begin
   Sortie;
   Err('Erreur de creation du Stream ...');
   AVIFileRelease(Pfile1);
   AVIFileExit;
   exit;
  end;

 Reponse :=AVIStreamSetFormat(NewAvi,0,BitmapInfo,InfoSize);
 if Reponse <> AVIERR_OK then
  begin
   Sortie;
   Err('Erreur de formatage du Stream Video ...');
   AVIStreamRelease(NewAvi);
   AVIFileRelease(Pfile1);
   AVIFileExit;
   exit;
  end;

 For Cp:=0 to ListBox1.Items.count-1 do
 Begin

  // Ecrit la Frame dans le fichier
  // ------------------------------
  //Label5.Caption:='Image : '+IntToStr(Cp)+' / '+IntToStr(ListBox1.Items.count);
  //Label5.Refresh;

  Image1.Picture.LoadFromFile(ListBox1.Items[Cp]);
  Image1.Refresh;
  GetDIB(Image1.Picture.Bitmap.Handle,Image1.Picture.Bitmap.Palette,BitmapInfo^,Image^);
  Image1.Refresh;

  // Ecrit le stream video
  Reponse:=AVIStreamWrite(NewAvi,Cp,1,Image,ImageSize,AVIIF_KEYFRAME,C,C1);
  if Reponse <> AVIERR_OK then
  begin
   Sortie;
   AVIStreamRelease(NewAvi);
   AVIFileRelease(Pfile1);
   AVIFileExit;
   Err('Erreur Stream Video Write ...');
   Exit;
  end;

 End;

 Sortie;

 AVIStreamRelease(NewAvi);
 AVIFileRelease(Pfile1);
 AVIFileExit;
 end;
except
end;
End;

procedure TBmpToAviForm.addButtonClick(Sender: TObject);
var
i:integer;
begin
 OpenDialog1.Filter := 'Fichiers BMP (*.bmp)|*.bmp';
 OpenDialog1.FileName:='*.bmp';
 OpenDialog1.FilterIndex := 2;
 If OpenDialog1.Execute then
  Begin
   for i:=0 to OpenDialog1.Files.Count-1 do
   begin
     Fichier:=OpenDialog1.Files.Strings[i];
     If Pos('*.bmp',Fichier)=0 then
       Begin
         Image1.Picture.LoadfromFile(Fichier);
         ListBox1.Items.Add(Fichier);
       End;
   end;
  End;
end;

procedure TBmpToAviForm.OkButtonClick(Sender: TObject);
begin
CreerAvi;
end;

procedure TBmpToAviForm.CloseButtonClick(Sender: TObject);
begin
Close;
end;

end.