www.pudn.com > »Ò¸ë×ÓVIP1.2.rar > BmpToAviUnit.pas

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.