Einzelbilder in ein Video umwandeln

DarkLord · Beiträge: 34

Hi!

Ich bin gerade dabei einen kleinen Recorder zu basteln, der alle Aktionen auf dem Bildschirm bzw. im aktuellen Fenster als Video aufzeichnen soll.
Das Programm erzeugt mit Hilfe eines Timers x mal pro Sekunde einen Screenshot. Nun ist nur die Frage, wie man die Bilder in ein Video laden kann!? Ich habe schon auf zig Seiten gesucht und "gegooglt" bis zum umfallen. Ich habe immer nur Tipps gefunden wie man Bilder aus einem Video entnimmt und nicht umgekehrt.

Hat jemand ne Idee oder einen Link zu einem Tutorial, was mir da helfen könnte?

Grüße Tim

P.S.: Falls der Text wirr sein sollte bitte ich dies zu entschuldigen (is einfach zu spät)! Da ich kaum noch die Schrift auf dem Monitor erkenne, werde ich nun ins Bett fallen. :mrgreen:

N8

Delphianer23 · Beiträge: 156

dann bastel dir doch einfach nen Player dazu. d.h du lädst einfach im gleichen Timerinterval deine Bilder in ein image.

Evl mit opengl, weil das schneller ist, da es mehr über die Grafikkarte geht. Wie man ein wirkliches Videoformat draus macht, weiß ich allerdings auch nicht, aber so ist das doch kein Problem oder?

Für was brauchst du es denn? (AHH eine Idee, du machst es wie oben beschrieben und filmst dann einfach mit ner Digitalkamera deinen Bildschirm ab, flimmert halt wie die Sau)

Moderiert von Tino: Absätze entfernt.

1Stein · Beiträge: 30

wenn du aber dauernt screenies machst und gleichzeitig deinen film abspielen wisst (was ich glaube aus deinem wirrwar entnommen zu haben) selbst wenn du OpenGL benutzt dein rechner wäre warscheinlich nach 30 Screens spätestens total überlasstet weil dann ganzviele Bilder im Bild entstehen also ich empfehele eher die Screens abzuspeichern und mit nem Video prog (z.B.: Windows Movie Maker bei XP dabei) zusammen zu schneiden oder halt ne mega Gifanimation machen (z.B.: mit Ulead Gif Animator 5) naja viel glück

_________________
1Stein wäre nie 1Stein geworden wenn 2Stein nicht gewesen wäre

Delphianer23 · Beiträge: 156

du hast mich falsch verstanden

1. Bildern in timerinterval abspeichern

2. SPÄTER fertige Bilder im Gleichen Timerinterval einfach
in ein image laden

=> fertig ist der Film

(Besser ist es die ausgabe statt auf einem image mit opengl
zu machen)

Jetzt kapiert?? (Ist natürlich nicht die beste Mehtode)

DarkLord · Beiträge: 34

Ihr habt mich etwas misverstanden,a ber halb so wild! *g* Trotzdem danke für die Antworten!

Das Prog soll erstmal nur dazu dienen den Bildschirm abzufilmen. Und es ist mir wichtig, dass dabei ein richtiges Video rauskommt und keine Gif-Ani oder so. Ich mchte auch kein externes Programm benutzen um das Video zu erstellen. Das soll da alles enthalten sein. Die Wiedergabe soll dann über ein anderes Programm (bzw. Programmteil) oder über irgendeinen Videoplayer erfolgen.
Ich habe auch schonmal eine Shareware Komponente gefunden, die sowas ähnliches macht. Nur leider war das Teil schon vorkompiliert und ich würde es gern selber proggen.

tommie-lie · Beiträge: 4373 Ubuntu 7.10 "Gutsy Gibbon"

ich glaube, ihr versteht Darklords Problem nicht ganz. Er will einen AVI-Film machen. Bzw. überhaupt einen Film, nicht unbedingt AVI. Er will nicht alle Bilder einzelnd Speichern und später wieder laden (mal ganz abgesehen davon, daß das ja wohl ein Film für Arme wäre...), sondern alles in einen Film machen.
Wie's mit Quicktime geht, weiß ich nicht, aber über AVIs dürftest du was im Win32-SDK finden. Soweit ich weiß, werden Bilder einzelnd hinzugefügt, aber mehr weiß ich leider auch nicht.
Wenn du auch vor Komponenten nicht zurückschreckst, gibt's bei GLScene eine openGL-Komponentensammlung. Mit dabei ist ein TAVIRecorder, der genau das macht, was du willst. Das Projekt wird zwar duch den Vektor- und Grafik-Ballast wesentlich größer, aber wenn du probierst, alles rauszuwerfen, was nix mit dem Recorder zu tun hat, dürfte sich das noch in annehmbaren Grenzen halten. Der öffnet dir einen Stream und du kannst Bilder hinzufügen. Gleichzeitig kannst du das Video komprimieren (ohne mehraufwand), also gleich einen MPeg-Film raus machen, oder sogar DiVX. Allerdings kann MPeg- und DiVX-Codierung lange dauern, ob du da also noch auf 25 fps kommst, ist zu bezweifeln.

_________________
Your computer is designed to become slower and more unreliable over time, so you have to upgrade. But if you'd like some false hope, I can tell you how to defragment your disk. - Dilbert

DarkLord · Beiträge: 34

Danke! Das werde ich mir mal ansehn! Und 25fps brauch ich nicht unbedingt! Mir reichen schon ca. 15 (muss also keine super Qualität sein)! Denn wenn das alles so klappt soll das dann übers Internet übertragen werden als nächster Schritt.

1Stein · Beiträge: 30

ne webpccam :mrgreen:

_________________
1Stein wäre nie 1Stein geworden wenn 2Stein nicht gewesen wäre

Gast Erhaltene Danke: 1

@DarkLord

Guck dir meinen meinen Webrecorder an:

www.delphi-forum.de/viewtopic.php?t=6470

Das ist zumindest der Teil der das Filmen übernimmt. Alternativ gibts noch den PopSpy auf meiner Webseite. Wenn du dir die Beiden Programme anguckst, dann wirst du feststellen, daß ich bei dem Webrekorder mit Jpeg arbeite. Ist für den Bildschirm (also normale Programmfenster) nicht zu gebrauchen. Bei dem PopSpy kannst du auch mit Bmp arbeiten. Du wirst aber feststellen, daß pro Bild ca. 3MB verbraucht werden. Da verbrauchst du für 60s. bei 15 Bildern pro Sekunde ca. 2.7GByte. Mit AVI oder MPEG kommst du hier also nicht weiter. Es gibt schon einen Grund wieso ich in meinen Programmen nur ein mal pro Sekunde ein Bild zulasse. Wenn du also ein Vidofilm von dem Bildschirm machen willst, dann muß du dein eigenes Format erstellen und auch einen eigenen Free-Player dazu. Der Recorder dagegen nimmt nur das eine kleine Rechteck auf in dem sich gerade etwas verändert hat. Und wenn sich nichts verändert hat, dann werden auch keine Bilder aufgenommen.

DarkLord · Beiträge: 34

Hm, das ist ein interessanter Punkt. Und ein Komprimieren in Realtime kommt wahrscheinlich auh nicht in Frage wegen der erforderlichen Leistung.
Aber was für ein Bildfprmat könnte man da am besten nehmen? Bei JPEG sieht man die kompression zu stark (wär ungeeignet bei kleinen Schriften etc.).. GIF ist da schon wesentlich besser, jedoch auf 256 Farben begrenzt. PNG hat die Beschränkungen nicht, wird aber zu groß.
Naja, ich werde mal etwas tüfteln und mal sehen was so bei rauskommt.

Aya · Verfasst: So 16.02.03 20:29

Hi...

also wenn du JPEG nimmst schaffst du nie und nimmer 25 FPS...

Bei ner auflösung von 1024x768 dauert es seine zeit das Bild in JPEG zu Komprimieren. Das einzige Format was da wirklich geht ist unkomprimiertes BMP.. und somit dann auch Unkomprimiertes AVI.

Sicher, braucht anfangs wahnsinnig viel speicher, aber um in Echtzeit aufzunehmen bei der Auflösung (eventuell ja sogar 1600x1200 oder so) geht es nich anders denke ich mal...

das komprimieren des Videos würde ich dann am ende nochmal seperat machen.

(und unkomprimiertes Avi.. das dürfte nich sonderlichschwer zu machen sein, sind ja im grunde aneinandergereihte Bitmaps)

Au'revoir,
Aya

_________________
Aya
I aim for my endless dreams and I know they will come true!

Simon Joker · Beiträge: 236 Erhaltene Danke: 1

Ich habe das Gleiche Problem gehabt UND auch was gefunden:

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:

//________Programm________
program AVIBuilder;

uses
  Forms,
  AniTool in 'AniTool.pas' {AniToolForm},
  VFW in 'vfw.pas',
  DIBitmap in 'DIBitmap.pas',
  IUnk in 'IUnk.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TAniToolForm, AniToolForm);
  Application.Run;
end.

//________MainForm_________
unit AniTool;

{This tool allows the user to easily create avi files for use, for example, with
the Delphi/C++Builder TAnimate component.  It is an improvement on an old
freeware thing I found lying around somewhere.  Unfortunately I don't know who
wrote the original, but all of the work in VFW and DIBitmap is his (or hers).

You can use this software however you want so long as it remains free.  Please
leave in some mention of Anderson Software.  Also, if anyone knows who did the
work on VFW and DIBitmap, please add their names too.

I think its use is pretty obvious.  Add some bitmaps, sort them and then create
the avi.  It has to be saved before the preview starts.  The frame counter lets
you speed up or slow down the animation, but it has to be saved again before the
change registers (as do any changes of frame order).

17 December 1998
Rob Anderson
Anderson Software - Geneva, Switzerland
anderson@nosredna.com
}

interface

uses
  SysUtils, ComCtrls, StdCtrls, Spin, Buttons, ToolWin, Menus, Dialogs,
  ExtCtrls, Controls, Classes, Forms;

type
  TAniToolForm = class(TForm)
    BitmapListBox: TListBox;
    AddBitmapDialog: TOpenDialog;
    SaveAVIDialog: TSaveDialog;
    Panel2: TPanel;
    Panel3: TPanel;
    Splitter1: TSplitter;
    Animate1: TAnimate;
    Label1: TLabel;
    ToolBar1: TToolBar;
    SpeedButton4: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    spinRate: TSpinEdit;
    SpeedButton1: TSpeedButton;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    Panel1: TPanel;
    BitmapImage: TImage;
    Label2: TLabel;
    StatusBar1: TStatusBar;
    procedure SpeedButton4Click(Sender: TObject);
    procedure BitmapListBoxClick(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
  private
    { Private Declarations }
  public
    { Public Declarations }
  end;

var
  AniToolForm: TAniToolForm;

implementation

uses Windows, Graphics, VFW, DIBitmap;

{$R *.DFM}

procedure TAniToolForm.SpeedButton4Click(Sender: TObject);
var
  MyBitmap: TBitmap;
  i:        Integer;
begin
  with AddBitmapDialog do
    if Execute then
      for i:=0 to Files.Count-1 do
      begin
        MyBitmap := TBitmap.Create;
        MyBitmap.LoadFromFile(Files[i]);
        BitmapListBox.Items.AddObject(ExtractFileName(Files[i]),MyBitmap);
      end;
end;

procedure TAniToolForm.BitmapListBoxClick(Sender: TObject);
begin
  with BitmapListBox do
    if SelCount>1 then
      BitmapImage.Picture := nil
    else
      BitmapImage.Picture.Bitmap := Items.Objects[ItemIndex] as TBitmap;
end;

procedure TAniToolForm.SpeedButton3Click(Sender: TObject);
var
  i: Integer;
begin
  with BitmapListBox do
    for i:=Items.Count-1 downto 0 do
      if Selected[i] then
      begin
        (Items.Objects[i] as TBitmap).Free;
        Items.Delete(i);
      end;
end;

procedure TAniToolForm.SpeedButton1Click(Sender: TObject);
var
  i: Integer;
  pfile: PAVIFile;
  asi: TAVIStreamInfo;
  ps: PAVIStream;
  nul: Longint;

  BitmapInfo: PBitmapInfoHeader;
  BitmapInfoSize: Integer;
  BitmapBits: Pointer;
  BitmapSize: Integer;
begin
  Animate1.Filename := '';
  Animate1.Active := False;

  with BitmapListBox, SaveAVIDialog do
    if Execute then
    begin
      AVIFileInit;

      if AVIFileOpen(pfile, PChar(FileName), OF_WRITE or OF_CREATE, nil)=AVIERR_OK then
      begin
        FillChar(asi,sizeof(asi),0);

        asi.fccType := streamtypeVIDEO;                 //  Now prepare the stream
        asi.fccHandler := 0;
        asi.dwScale := 1;
        asi.dwRate := spinRate.Value;

        with Items.Objects[0] as TBitmap do
        begin
          InternalGetDIBSizes(Handle,BitmapInfoSize,DWORD(BitmapSize),Integer(256));
          BitmapInfo := AllocMem(BitmapInfoSize);
          BitmapBits := AllocMem(BitmapSize);
          InternalGetDIB(Handle,0,BitmapInfo^,BitmapBits^,256);
        end;

        asi.dwSuggestedBufferSize := BitmapInfo^.biSizeImage;
        asi.rcFrame.Right := BitmapInfo^.biWidth;
        asi.rcFrame.Bottom := BitmapInfo^.biHeight;

        if AVIFileCreateStream(pfile,ps,asi)=AVIERR_OK then
          with (Items.Objects[0] as TBitmap) do
          begin
            InternalGetDIB(Handle,0,BitmapInfo^,BitmapBits^,256);
            if AVIStreamSetFormat(ps,0,BitmapInfo,BitmapInfoSize)=AVIERR_OK then
            begin
              for i:=0 to Items.Count-1 do
                with (Items.Objects[i] as TBitmap) do
                begin
                  InternalGetDIB(Handle,0,BitmapInfo^,BitmapBits^,256);
                  if AVIStreamWrite(ps,i,1,BitmapBits,BitmapSize,AVIIF_KEYFRAME,nul,nul)<>AVIERR_OK then
                  begin
                    raise Exception.Create('Could not add frame');
                    break;
                  end;
                end;
            end;
          end;
          FreeMem(BitmapInfo);
          FreeMem(BitmapBits);
        end;

      AVIStreamRelease(ps);
      AVIFileRelease(pfile);

      AVIFileExit;
    end;
    if FileExists(SaveAVIDialog.Filename) then begin
      Animate1.Filename := SaveAVIDialog.Filename;
      Animate1.Active := True;
    end;
end;

procedure TAniToolForm.SpeedButton2Click(Sender: TObject);
var jnSelectedItem : word;
begin
  jnSelectedItem := BitmapListBox.ItemIndex;
  if jnSelectedItem > 0 then begin
    BitmapListBox.Items.Move(jnSelectedItem, jnSelectedItem - 1);
    BitmapListBox.Selected[jnSelectedItem - 1] := True;
  end;
end;

procedure TAniToolForm.SpeedButton5Click(Sender: TObject);
var jnSelectedItem : word;
begin
  jnSelectedItem := BitmapListBox.ItemIndex;
  if jnSelectedItem < BitmapListBox.Items.Count - 1 then begin
    BitmapListBox.Items.Move(jnSelectedItem, jnSelectedItem + 1);
    BitmapListBox.Selected[jnSelectedItem + 1] := True;
  end;
end;

procedure TAniToolForm.SpeedButton6Click(Sender: TObject);
begin
  BitmapListBox.Sorted := not BitmapListBox.Sorted;
end;

end.

//__________VFW___________
unit VFW;

{ don't know who wrote this - the AVI section for avifil32.dll - Thanks !!!}

interface

uses Windows, IUnk;

type

{ TAVIFileInfoW record }

  LONG = Longint;
  PVOID = Pointer;

  TAVIFileInfoW = record
    dwMaxBytesPerSec,  // max. transfer rate
    dwFlags,    // the ever-present flags
    dwCaps,
    dwStreams,
    dwSuggestedBufferSize,

    dwWidth,
    dwHeight,

    dwScale,
    dwRate,  // dwRate / dwScale == samples/second
    dwLength,

    dwEditCount: DWORD;

    szFileType: array[0..63] of WideChar;    // descriptive string for file type?
  end;
  PAVIFileInfoW = ^TAVIFileInfoW;

{ TAVIStreamInfoA record }

  TAVIStreamInfoA = record
    fccType,
    fccHandler,
    dwFlags,        // Contains AVITF_* flags
    dwCaps: DWORD;
    wPriority,
    wLanguage: WORD;
    dwScale,
    dwRate, // dwRate / dwScale == samples/second
    dwStart,
    dwLength, // In units above...
    dwInitialFrames,
    dwSuggestedBufferSize,
    dwQuality,
    dwSampleSize: DWORD;
    rcFrame: TRect;
    dwEditCount,
    dwFormatChangeCount,
    szName:  array[0..63] of AnsiChar;
  end;
  TAVIStreamInfo = TAVIStreamInfoA;
  
{ TAVIStreamInfoW record }

  TAVIStreamInfoW = record
    fccType,
    fccHandler,
    dwFlags,        // Contains AVITF_* flags
    dwCaps: DWORD;
    wPriority,
    wLanguage: WORD;
    dwScale,
    dwRate, // dwRate / dwScale == samples/second
    dwStart,
    dwLength, // In units above...
    dwInitialFrames,
    dwSuggestedBufferSize,
    dwQuality,
    dwSampleSize: DWORD;
    rcFrame: TRect;
    dwEditCount,
    dwFormatChangeCount,
    szName:  array[0..63] of WideChar;
  end;

{ IAVIStream interface }

  IAVIStream = class(IUnknown)
    function Create(lParam1, lParam2: LPARAM): HResult; virtual; stdcall; abstract;
    function Info(var psi: TAVIStreamInfoW; lSize: LONG): HResult; virtual; stdcall; abstract;
    function FindSample(lPos, lFlags: LONG): LONG; virtual; stdcall; abstract;
    function ReadFormat(lPos: LONG; lpFormat: PVOID; var lpcbFormat: LONG): HResult; virtual; stdcall; abstract;
    function SetFormat(lPos: LONG; lpFormat: PVOID; lpcbFormat: LONG): HResult; virtual; stdcall; abstract;
    function Read(lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; var plBytes: LONG; var plSamples: LONG): HResult; virtual; stdcall; abstract;
    function Write(lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; virtual; stdcall; abstract;
    function Delete(lStart, lSamples: LONG): HResult; virtual; stdcall; abstract;
    function ReadData(fcc: DWORD; lp: PVOID; var lpcb: LONG): HResult; virtual; stdcall; abstract;
    function WriteData(fcc: DWORD; lp: PVOID; cb:  LONG): HResult; virtual; stdcall; abstract;
    function SetInfo(var lpInfo: TAVIStreamInfoW; cbInfo: LONG): HResult; virtual; stdcall; abstract;
  end;
  PAVIStream = ^IAVIStream;

{ IAVIFile interface }

  IAVIFile = class(IUnknown)
    function Info(var pfi: TAVIFileInfoW; lSize: LONG): HResult; virtual; stdcall; abstract;
    function GetStream(var ppStream: PAVIStream; fccType: DWORD; lParam: LONG): HResult; virtual; stdcall; abstract;
    function CreateStream(var ppStream: PAVIStream; var pfi: TAVIFileInfoW): HResult; virtual; stdcall; abstract;
    function WriteData(ckid: DWORD; lpData: PVOID; cbData: LONG): HResult; virtual; stdcall; abstract;
    function ReadData(ckid: DWORD; lpData: PVOID; var lpcbData: LONG): HResult; virtual; stdcall; abstract;
    function EndRecord: HResult; virtual; stdcall; abstract;
    function DeleteStream(fccType: DWORD; lParam: LONG): HResult; virtual; stdcall; abstract;
  end;
  PAVIFile = ^IAVIFile;

procedure AVIFileInit; stdcall;
procedure AVIFileExit; stdcall;
function AVIFileOpen(var ppfile: PAVIFile; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID): HResult; stdcall;
function AVIFileCreateStream(pfile: PAVIFile; var ppavi: PAVISTREAM; var psi: TAVIStreamInfoA): HResult; stdcall;
function AVIStreamSetFormat(pavi: PAVIStream; lPos: LONG; lpFormat: PVOID; cbFormat: LONG): HResult; stdcall;
function AVIStreamWrite(pavi: PAVIStream; lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; stdcall;
function AVIStreamRelease(pavi: PAVISTREAM): ULONG; stdcall;
function AVIFileRelease(pfile: PAVIFile): ULONG; stdcall;

const
  AVIERR_OK       = 0;

  AVIIF_LIST      = $01;
  AVIIF_TWOCC    = $02;
  AVIIF_KEYFRAME  = $10;

  streamtypeVIDEO = $73646976; // DWORD( 'v', 'i', 'd', 's' )

{ AVI interface IDs }

  IID_IAVIFile: TGUID = (
    D1:$00020020;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  IID_IAVIStream: TGUID = (
    D1:$00020021;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  IID_IAVIStreaming: TGUID = (
    D1:$00020022;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  IID_IGetFrame: TGUID = (
    D1:$00020023;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  IID_IAVIEditStream: TGUID = (
    D1:$00020024;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));

{ AVI class IDs }

  CLSID_AVISimpleUnMarshal: TGUID = (
    D1:$00020009;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  CLSID_AVIFile: TGUID = (
    D1:$00020000;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));

implementation

procedure AVIFileInit; stdcall; external 'avifil32.dll' name 'AVIFileInit';
procedure AVIFileExit; stdcall; external 'avifil32.dll' name 'AVIFileExit';
function AVIFileOpen(var ppfile: PAVIFILE; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID): HResult; external 'avifil32.dll' name 'AVIFileOpenA';
function AVIFileCreateStream(pfile: PAVIFile; var ppavi: PAVIStream; var psi: TAVIStreamInfoA): HResult; external 'avifil32.dll' name 'AVIFileCreateStreamA';
function AVIStreamSetFormat(pavi: PAVIStream; lPos: LONG; lpFormat: PVOID; cbFormat: LONG): HResult; external 'avifil32.dll' name 'AVIStreamSetFormat';
function AVIStreamWrite(pavi: PAVIStream; lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; external 'avifil32.dll' name 'AVIStreamWrite';
function AVIStreamRelease(pavi: PAVIStream): ULONG; external 'avifil32.dll' name 'AVIStreamRelease';
function AVIFileRelease(pfile: PAVIFile): ULONG; external 'avifil32.dll' name 'AVIFileRelease';

end.

//_________IUnk_____________
unit IUnk;

{This allows us to subclass IUnknown without having to include the now defunct
ole2.pas.

17 December 1998
Rob Anderson
Anderson Software - Geneva, Switzerland
anderson@nosredna.com
}

interface

uses Windows;

type

{ Result code }

  HResult = Longint;

{ Globally unique ID }

  PGUID = ^TGUID;
  TGUID = record
    D1: Longint;
    D2: Word;
    D3: Word;
    D4: array[0..7] of Byte;
  end;

{ Interface ID }

  PIID = PGUID;
  TIID = TGUID;

{ Class ID }

  PCLSID = PGUID;
  TCLSID = TGUID;

{ IUnknown interface }

  IUnknown = class
  public
    function QueryInterface(const iid: TIID; var obj): HResult; virtual; stdcall; abstract;
    function AddRef: Longint; virtual; stdcall; abstract;
    function Release: Longint; virtual; stdcall; abstract;
  end;

implementation

end.

//_________DIBitMap__________
unit DIBitmap;

{ don't know who wrote this - Thanks !!!}

interface

uses Windows, SysUtils, Classes;

procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader;
  Colors: Integer);

procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer;
  var ImageSize: DWORD; Colors: Integer);

function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE;
  var BitmapInfo; var Bits; Colors: Integer): Boolean;

implementation

procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader;
  Colors: Integer);
var
  BM: Windows.TBitmap;
begin
  GetObject(Bitmap, SizeOf(BM), @BM);
  with BI do
  begin
    biSize := SizeOf(BI);
    biWidth := BM.bmWidth;
    biHeight := BM.bmHeight;
    if Colors <> 0 then
      case Colors of
        2: biBitCount := 1;
        16: biBitCount := 4;
        256: biBitCount := 8;
      end
    else biBitCount := BM.bmBitsPixel * BM.bmPlanes;
    biPlanes := 1;
    biXPelsPerMeter := 0;
    biYPelsPerMeter := 0;
    if biBitCount>8 then biClrUsed := 0 else biClrUsed := Colors;
    biClrImportant := 0;
    biCompression := BI_RGB;
    if biBitCount in [16, 32] then biBitCount := 24;
    biSizeImage := (((biWidth * biBitCount) + 31) div 32) * 4 * biHeight;
  end;
end;

procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer;
  var ImageSize: DWORD; Colors: Integer);
var
  BI: TBitmapInfoHeader;
begin
  InitializeBitmapInfoHeader(Bitmap, BI, Colors);
  with BI do
  begin
    case biBitCount of
      24: InfoHeaderSize := SizeOf(TBitmapInfoHeader);
    else
      InfoHeaderSize := SizeOf(TBitmapInfoHeader) + SizeOf(TRGBQuad) *
       (1 shl biBitCount);
    end;
  end;
  ImageSize := BI.biSizeImage;
end;

function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE;
  var BitmapInfo; var Bits; Colors: Integer): Boolean;
var
  OldPal: HPALETTE;
  Focus: HWND;
  DC: HDC;
begin
  InitializeBitmapInfoHeader(Bitmap, TBitmapInfoHeader(BitmapInfo), Colors);
  OldPal := 0;
  Focus := GetFocus;
  DC := GetDC(Focus);
  try
    if Palette <> 0 then
    begin
      OldPal := SelectPalette(DC, Palette, False);
      RealizePalette(DC);
    end;
    Result := GetDIBits(DC, Bitmap, 0, TBitmapInfoHeader(BitmapInfo).biHeight, @Bits,
      TBitmapInfo(BitmapInfo), DIB_RGB_COLORS) <> 0;
  finally
    if OldPal <> 0 then SelectPalette(DC, OldPal, False);
    ReleaseDC(Focus, DC);
  end;
end;

end.

Gewuerzgurke · Beiträge: 152 Win XP Lazarus

Hallo, ich arbeite auch gerade an AVI-Aufzeichnung, dachte mir, ich fange mal mit Unkomprimierten an und fand dieses Thema. Ich habe mich weitestgehend an Simon Jokers Quellcode orientiert und glaube das Prinzip verstanden zu haben (ganz kurz):
Man öffnet als erstes mit AVIFileOpen ein AVI, das man erstellen will oder dem man neue Bilder hinzufügen will.
Dann öffnet man mit AVIFileCreateStreamA einen neues Stream (auf gleiche Weise komprimierter Abschnitt) in diesem AVI.
Dann stellt man mit AVIStreamSetFormat das Format für diesen Stream ein, also Breite * Höhe * Farbtiefe, glaub' ich (da hängt's bei mir).
Dann fügt man mit AVIStreamWrite dem ganzen ein neues Bild hinzu...

Ich komme einfach nicht dahinter, was AVIStreamSetFormat erwartet. Das verläuft sich in diesem Quelltext irgendwo in der DIBitmap.pas.

Ich dachte mir:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:

var Format : PBitmapInfoHeader;

// Einstellungen für Format

AVIStreamSetFormat(AviStream,0,Format,SizeOf(Format^))

Kann mir jemand erklären, wie man die Einstellungen für's Format macht?
Ich denk' mal, man muss das Bitmap erst als TBitmap, oder so, laden und dann... ???? :shock:

jaenicke · Verfasst: Sa 14.11.09 19:16

Siehe Dokumentation was die Parameter angeht:
msdn.microsoft.com/e...ibrary/dd756856.aspx
Aber das sieht soweit auch gut aus.

Hast du denn eine solche Struktur auch wirklich im Speicher, diesen also auch reserviert? Oder hast du nur diesen Pointer, der ggf. ins Nirgendwo zeigt?
Warum nimmst du nicht einfach eine Variable vom Typ der Struktur statt dem Pointer und übergibst dann den Pointer darauf (mit @)?

Gewuerzgurke · Beiträge: 152 Win XP Lazarus

Ok, wenn das soweit stimmt...

AVIStreamSetFormat erwartet einen PVOID - keine Ahnung, was das ist - in meinem Fall muss ich wohl einen Pointer auf ein BitmapInfoHeader angeben. Es ist auch wirklich besser, den BitmapInfoHeader so zu definieren und mit @Format zu übergeben. Ich habe mal in der Borland-Hilfe gesucht und bemerkt, dass BitmapInfoHeader ein Record ist. Welche der dort verlangten Parameter muss ich denn angeben?

Falls das zufällig gerade jemand weiß... Aber das finde ich auch alleine raus.
Ich muss nur heute noch weg.

Ich schreib' dann morgen wieder, wenn's geht oder eben nicht ...

Danke erstmal.

Gewuerzgurke · Beiträge: 152 Win XP Lazarus

Hm.. Jetzt bekomme ich bei AVIStreamWrite (ist in meinem Fall AVI.StreamWrite) eine Fehlermeldung. Ich habe die avifil32.dll dynamisch geladen und die vielen Variablen in ein Record gepackt... Ich finde das übersichtlicher. Die procedure PresCreateAVIRecorder soll das in test geladene Bitmap in ein AVI speichern, so für den Anfang.

Die procedure erwartet ein Paar Parameter, die ich aber zur Fehlersuche alle nochmal überschrieben habe. In der procedure steht als erstes, wie das Bitmap geladen wird, dann wie die DLL geladen wird, dann wie AVIFileCreateStreamA und AVIStreamSetFormat "bearbeitet" werden und dann, wie das Bitmap in's AVI geschrieben werden soll aber hier kommt immer eine Zugriffsverletzung.

Ich würde mich sehr freuen, wenn mal jemand, der/die das schon mal gemacht hat, drüber schauen könnte.
Ich weiß einfach nicht, ob ich das Bitmap falsch geladen habe, das AVI-Format falsch eingestellt habe oder ob der Fehler nicht doch woanders liegt...

So, jetzt mein Quellcode:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:

type
 TAVIFileInit = procedure; stdcall;
 TAVIFileExit = procedure; stdcall;
 TAVIFileOpen = function(var ppfile: PAVIFILE; szFile: LPCSTR; uMode: UINT;
  lpHandler: PCLSID): HResult; stdcall;
 TAVIFileCreateStream = function(pfile: PAVIFile; var ppavi: PAVIStream; var
  psi: TAVIStreamInfoA): HResult; stdcall;
 TAVIStreamSetFormat = function(pavi: PAVIStream; lPos: LONG; lpFormat: PVOID;
  cbFormat: LONG): HResult; stdcall;
 TAVIStreamWrite = function(pavi: PAVIStream; lStart, lSamples: LONG;
  lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten: LONG;
  var plBytesWritten: LONG): HResult; stdcall;
 TAVIStreamRelease = function(pavi: PAVIStream): ULONG; stdcall;
 TAVIFileRelease = function(pfile: PAVIFile): ULONG; stdcall;
 TAVI = record
  FileInit         : TAviFileInit;
  FileExit         : TAVIFileExit;
  FileOpen         : TAVIFileOpen;
  FileCreateStream : TAVIFileCreateStream;
  StreamSetFormat  : TAVIStreamSetFormat;
  StreamWrite      : TAVIStreamWrite;
  StreamRelease    : TAVIStreamRelease;
  FileRelease      : TAVIFileRelease;
  Libary           : THandle;
  AFile            : PAviFile;
  StreamInfo       : TAVIStreamInfo;
  Stream           : PAVIStream;
  Format           : BitmapInfoHeader;
 end;

var
 Avi     : TAvi;
 Created : Boolean  = false;
 Format  : Cardinal = 0;

procedure PresCreateAVIRecorder(FileName : PChar; Width,Height : integer;
 ColorDepth : cardinal; PicturesPerSec : integer);
var
 test : TPicture;
 nul : Longint;
 Picture : Pointer;
 PictureSize : integer;
begin

 // Bitmap test laden

 nul := 0;
 test := TPicture.Create;
 test.Bitmap.Handle := LoadImage(0,
  'C:\Dokumente und Einstellungen\Ich\Desktop\Bild.bmp',IMAGE_BITMAP,0,0,
  LR_LOADFROMFILE or LR_DEFAULTCOLOR);
 Picture := Pointer(test.Bitmap.Handle);
 Width := test.Bitmap.Width;
 Height := test.Bitmap.Height;
 ColorDepth := 256;
 PicturesPerSec := 2;
 PictureSize := Height * Width;  // Wenn PictureSize Null ist, kommt kein Fehler
 FileName := 'C:\Dokumente und Einstellungen\Ich\Desktop\test.avi';

 // Avi-Aufzeichnung beginnen

 AVI.Libary := LoadLibrary(PAnsiChar('avifil32.dll'));
 if (AVI.Libary = 0) then begin
  ShowMessage('"avifil32.dll" wurde nicht gefunden. Avi-Aufzeichnung ist ' +
   'nicht möglich');
  exit;
 end;
 try
  @Avi.FileInit := GetProcAddress(AVI.Libary, 'AVIFileInit');
  @Avi.FileExit := GetProcAddress(AVI.Libary, 'AVIFileExit');
  @Avi.FileOpen := GetProcAddress(AVI.Libary, 'AVIFileOpenA');
  @Avi.FileCreateStream := GetProcAddress(AVI.Libary, 'AVIFileCreateStreamA');
  @Avi.StreamSetFormat := GetProcAddress(AVI.Libary, 'AVIStreamSetFormat');
  @Avi.StreamWrite := GetProcAddress(AVI.Libary, 'AVIStreamWrite');
  @Avi.StreamRelease := GetProcAddress(AVI.Libary, 'AVIStreamRelease');
  @Avi.FileRelease := GetProcAddress(AVI.Libary, 'AVIFileRelease');
  Created := true;
  if (@Avi.FileInit = nil) or
     (@Avi.FileExit = nil) or
     (@Avi.FileOpen = nil) or
     (@Avi.FileCreateStream = nil) or
     (@Avi.StreamSetFormat = nil) or
     (@Avi.StreamWrite = nil) or
     (@Avi.StreamRelease = nil) or
     (@Avi.FileRelease = nil) then Created := false;
 finally
 end;
 if (not Created) then begin
  Showmessage('Beim Laden der DLL "avifil32.dll" ist ein Fehler aufgetreten.' +
   ' Avi-Aufzeichnung ist nicht möglich.');
  exit;
 end;
 Created := false;
 
 AVI.FileInit;
 if (AVI.FileOpen(Avi.AFile,
                  FileName,
                  OF_WRITE or OF_CREATE,
                  nil) <> AVIERR_OK) then exit;

 with Avi.StreamInfo do begin
  fccType               := streamtypeVIDEO;
  fccHandler            := 0;
  dwScale               := 1;
  dwRate                := PicturesPerSec;
  dwSuggestedBufferSize := 0;
  rcFrame.Top           := 0;
  rcFrame.Left          := 0;
  rcFrame.Right         := Width;
  rcFrame.Bottom        := Height;
 end;
 if (AVI.FileCreateStream(Avi.AFile,
                          Avi.Stream,
                          Avi.StreamInfo) <> AVIERR_OK) then exit;

 with Avi.Format do begin
  biWidth         := Width;
  biHeight        := Height;
  biPlanes        := 1;
  biBitCount      := round(ln(ColorDepth) / 0.69314718); // <-- ist 8
  biCompression   := BI_RGB;
  biSizeImage     := 0;
  biXPelsPerMeter := Width;
  biYPelsPerMeter := Height;
  biClrUsed       := 0;
  biClrImportant  := 0;
  biSize          := SizeOf(Avi.Format);
 end;
 if (AVI.StreamSetFormat(Avi.Stream,
                         0,
                         @Avi.Format,
                         Avi.Format.biSize) <> AVIERR_OK) then exit;

 Created := true;
 Format := 1;

 // Bitmap test zu Avi hinzufügen

 if (AVI.StreamWrite(Avi.Stream,
                     0,
                     1,
                     Picture,
                     PictureSize,
                     AVIIF_KEYFRAME,
                     nul,
                     nul) <> AVIERR_OK) then begin
  ShowMessage('Konnte Bild nicht zu Video hinzufügen.' +
   ' Aufzeichnung wird beendet.');
 end;

 // Avi-Aufzeichnung beenden

 Avi.StreamRelease(Avi.Stream);
 Avi.FileRelease(Avi.AFile);
 Avi.FileExit;
 Created := false;
end;

PS:
Ich weiß, das ist viel verlangt aber in diesem Fall lässt sich auch kaum Quelltext einsparen...
Zumindest der Teil zum Laden der DLL (Zeile 61 - 94) sollte ohne Probleme laufen. Ich vermute den Fehler in falschen Einstellungen für Avi.StreamInfo oder Avi.Format.

Gewuerzgurke · Beiträge: 152 Win XP Lazarus

OK, ich hab's geschafft. Ich bin das Problem von der anderen Seite angegangen, was heißt, ich habe den funktionierenden Quellcode von Simon Joker genommen (musste noch die AniTool.dfm rekonstruieren) und solange reduziert, bis nur noch das nötigste übrig war.

Daraus habe ich mir dann folgende DLL gemacht:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:

library Recorder;

{ Quellcode zum Laden der 'avifil32.dll' ist von hier: http://www.delphi-forum.de/viewtopic.php?p=584718#584718 }

uses
 ShareMem, SysUtils, Classes, Windows, Dialogs, Math, Graphics, DIBitmap;


type

 { Result code }
 HResult = Longint;
 { Globally unique ID }
 PGUID = ^TGUID;
 TGUID = record
  D1: Longint;
  D2: Word;
  D3: Word;
  D4: array[0..7] of Byte;
 end;
 { Interface ID }
 PIID = PGUID;
 TIID = TGUID;
 { Class ID }
 PCLSID = PGUID;
 TCLSID = TGUID;
 { IUnknown interface }
 IUnknown = class
  public
   function QueryInterface(const iid: TIID; var obj): HResult; virtual; stdcall;
    abstract;
   function AddRef: Longint; virtual; stdcall; abstract;
   function Release: Longint; virtual; stdcall; abstract;
 end;

 { TAVIFileInfoW record }
 LONG = Longint;
 PVOID = Pointer;
 TAVIFileInfoW = record
  dwMaxBytesPerSec,  // max. transfer rate
  dwFlags,    // the ever-present flags
  dwCaps,
  dwStreams,
  dwSuggestedBufferSize,
  dwWidth,
  dwHeight,
  dwScale,
  dwRate,  // dwRate / dwScale == samples/second
  dwLength,
  dwEditCount: DWORD;
  szFileType: array[0..63] of WideChar;    // descriptive string for file type?
 end;
 PAVIFileInfoW = ^TAVIFileInfoW;
 { TAVIStreamInfoA record }
 TAVIStreamInfoA = record
  fccType,
  fccHandler,
  dwFlags,        // Contains AVITF_* flags
  dwCaps: DWORD;
  wPriority,
  wLanguage: WORD;
  dwScale,
  dwRate, // dwRate / dwScale == samples/second
  dwStart,
  dwLength, // In units above...
  dwInitialFrames,
  dwSuggestedBufferSize,
  dwQuality,
  dwSampleSize: DWORD;
  rcFrame: TRect;
  dwEditCount,
  dwFormatChangeCount,
  szName:  array[0..63] of AnsiChar;
 end;
 TAVIStreamInfo = TAVIStreamInfoA;
 { TAVIStreamInfoW record }
 TAVIStreamInfoW = record
  fccType,
  fccHandler,
  dwFlags,        // Contains AVITF_* flags
  dwCaps: DWORD;
  wPriority,
  wLanguage: WORD;
  dwScale,
  dwRate, // dwRate / dwScale == samples/second
  dwStart,
  dwLength, // In units above...
  dwInitialFrames,
  dwSuggestedBufferSize,
  dwQuality,
  dwSampleSize: DWORD;
  rcFrame: TRect;
  dwEditCount,
  dwFormatChangeCount,
  szName:  array[0..63] of WideChar;
 end;
 { IAVIStream interface }
 IAVIStream = class(IUnknown)
  function Create(lParam1, lParam2: LPARAM): HResult; virtual; stdcall;
   abstract;
  function Info(var psi: TAVIStreamInfoW; lSize: LONG): HResult; virtual;
   stdcall; abstract;
  function FindSample(lPos, lFlags: LONG): LONG; virtual; stdcall; abstract;
  function ReadFormat(lPos: LONG; lpFormat: PVOID; var lpcbFormat: LONG):
   HResult; virtual; stdcall; abstract;
  function SetFormat(lPos: LONG; lpFormat: PVOID; lpcbFormat: LONG): HResult;
   virtual; stdcall; abstract;
  function Read(lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG;
   var plBytes: LONG; var plSamples: LONG): HResult; virtual; stdcall; abstract;
  function Write(lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG;
   dwFlags: DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult;
   virtual; stdcall; abstract;
  function Delete(lStart, lSamples: LONG): HResult; virtual; stdcall; abstract;
  function ReadData(fcc: DWORD; lp: PVOID; var lpcb: LONG): HResult; virtual;
   stdcall; abstract;
  function WriteData(fcc: DWORD; lp: PVOID; cb:  LONG): HResult; virtual;
   stdcall; abstract;
  function SetInfo(var lpInfo: TAVIStreamInfoW; cbInfo: LONG): HResult; virtual;
   stdcall; abstract;
 end;
 PAVIStream = ^IAVIStream;
 { IAVIFile interface }
 IAVIFile = class(IUnknown)
  function Info(var pfi: TAVIFileInfoW; lSize: LONG): HResult; virtual; stdcall;
   abstract;
  function GetStream(var ppStream: PAVIStream; fccType: DWORD; lParam: LONG):
   HResult; virtual; stdcall; abstract;
  function CreateStream(var ppStream: PAVIStream; var pfi: TAVIFileInfoW):
   HResult; virtual; stdcall; abstract;
  function WriteData(ckid: DWORD; lpData: PVOID; cbData: LONG): HResult;
   virtual; stdcall; abstract;
  function ReadData(ckid: DWORD; lpData: PVOID; var lpcbData: LONG): HResult;
   virtual; stdcall; abstract;
  function EndRecord: HResult; virtual; stdcall; abstract;
  function DeleteStream(fccType: DWORD; lParam: LONG): HResult; virtual;
   stdcall; abstract;
 end;
 PAVIFile = ^IAVIFile;

 TAVIFileInit = procedure; stdcall;
 TAVIFileExit = procedure; stdcall;
 TAVIFileOpen = function(var ppfile: PAVIFILE; szFile: LPCSTR; uMode: UINT;
  lpHandler: PCLSID): HResult; stdcall;
 TAVIFileCreateStream = function(pfile: PAVIFile; var ppavi: PAVIStream; var
  psi: TAVIStreamInfoA): HResult; stdcall;
 TAVIStreamSetFormat = function(pavi: PAVIStream; lPos: LONG; lpFormat: PVOID;
  cbFormat: LONG): HResult; stdcall;
 TAVIStreamWrite = function(pavi: PAVIStream; lStart, lSamples: LONG;
  lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten: LONG;
  var plBytesWritten: LONG): HResult; stdcall;
 TAVIStreamRelease = function(pavi: PAVIStream): ULONG; stdcall;
 TAVIFileRelease = function(pfile: PAVIFile): ULONG; stdcall;
 TAVI = record
  FileInit         : TAviFileInit;
  FileExit         : TAVIFileExit;
  FileOpen         : TAVIFileOpen;
  FileCreateStream : TAVIFileCreateStream;
  StreamSetFormat  : TAVIStreamSetFormat;
  StreamWrite      : TAVIStreamWrite;
  StreamRelease    : TAVIStreamRelease;
  FileRelease      : TAVIFileRelease;
  Libary           : THandle;
  Stream           : PAVIStream;
  StreamInfo       : TAVIStreamInfo;
  Format           : PBitmapInfoHeader;
  FormatSize       : integer;
  AFile            : PAviFile;
  BitmapSize       : integer;
  BitmapBits       : Pointer;
  PictureCount     : cardinal;
  ColorDepth       : integer;
 end;

const
 AVIERR_OK       = 0;
 AVIIF_LIST      = $01;
 AVIIF_TWOCC    = $02;
 AVIIF_KEYFRAME  = $10;
 streamtypeVIDEO = $73646976; // DWORD( 'v', 'i', 'd', 's' )
 { AVI interface IDs }
 IID_IAVIFile: TGUID = (
  D1:$00020020;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
 IID_IAVIStream: TGUID = (
  D1:$00020021;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
 IID_IAVIStreaming: TGUID = (
  D1:$00020022;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
 IID_IGetFrame: TGUID = (
  D1:$00020023;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
 IID_IAVIEditStream: TGUID = (
  D1:$00020024;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
 { AVI class IDs }
 CLSID_AVISimpleUnMarshal: TGUID = (
  D1:$00020009;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
 CLSID_AVIFile: TGUID = (
  D1:$00020000;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));

var
 Avi     : TAvi;
 Created : Boolean  = false;
 Format  : Cardinal = 0;

{$R *.res}

procedure PresStopRecording;
begin
 if (not Created) then exit;
 case Format of
  1 : begin
   FreeMem(Avi.Format);
   FreeMem(Avi.BitmapBits);
   Avi.StreamRelease(Avi.Stream);
   Avi.FileRelease(Avi.AFile);
   Avi.FileExit;
   Created := false;
  end;
 end;
end;

procedure PresCreateAVIRecorder(FileName : PChar; Picture : TBitmap;
 ColorDepth : cardinal; PicturesPerSec : integer);
begin
 AVI.Libary := LoadLibrary(PAnsiChar('avifil32.dll'));
 if (AVI.Libary = 0) then begin
  ShowMessage('"avifil32.dll" wurde nicht gefunden. Avi-Aufzeichnung ist ' +
   'nicht möglich');
  exit;
 end;
 try
  @Avi.FileInit := GetProcAddress(AVI.Libary, 'AVIFileInit');
  @Avi.FileExit := GetProcAddress(AVI.Libary, 'AVIFileExit');
  @Avi.FileOpen := GetProcAddress(AVI.Libary, 'AVIFileOpenA');
  @Avi.FileCreateStream := GetProcAddress(AVI.Libary, 'AVIFileCreateStreamA');
  @Avi.StreamSetFormat := GetProcAddress(AVI.Libary, 'AVIStreamSetFormat');
  @Avi.StreamWrite := GetProcAddress(AVI.Libary, 'AVIStreamWrite');
  @Avi.StreamRelease := GetProcAddress(AVI.Libary, 'AVIStreamRelease');
  @Avi.FileRelease := GetProcAddress(AVI.Libary, 'AVIFileRelease');
  Created := true;
  if (@Avi.FileInit = nil) or
     (@Avi.FileExit = nil) or
     (@Avi.FileOpen = nil) or
     (@Avi.FileCreateStream = nil) or
     (@Avi.StreamSetFormat = nil) or
     (@Avi.StreamWrite = nil) or
     (@Avi.StreamRelease = nil) or
     (@Avi.FileRelease = nil) then Created := false;
 finally
 end;
 if (not Created) then begin
  Showmessage('Beim Laden der DLL "avifil32.dll" ist ein Fehler aufgetreten.' +
   ' Avi-Aufzeichnung ist nicht möglich.');
  exit;
 end;
 Created := false;
 AVI.FileInit;
 if (AVI.FileOpen(Avi.AFile,
                  PChar('C:\Dokumente und Einstellungen\Ich\Desktop\test.avi'),
                  OF_WRITE or OF_CREATE,
                  nil) <> AVIERR_OK) then exit;
 FillChar(Avi.StreamInfo,sizeOf(Avi.StreamInfo),0);
 Avi.StreamInfo.fccType := streamtypeVIDEO;
 Avi.StreamInfo.fccHandler := 0;
 Avi.StreamInfo.dwScale := 1;
 Avi.StreamInfo.dwRate := PicturesPerSec;
 InternalGetDIBSizes(Picture.Handle,
                     Avi.FormatSize,
                     DWORD(Avi.BitmapSize),
                     Integer(ColorDepth));
 Avi.Format := AllocMem(Avi.FormatSize);
 Avi.BitmapBits := AllocMem(Avi.BitmapSize);
 InternalGetDIB(Picture.Handle,0,Avi.Format^,Avi.BitmapBits^,ColorDepth);
 Avi.StreamInfo.dwSuggestedBufferSize := Avi.Format^.biSizeImage;
 Avi.StreamInfo.rcFrame.Right := Avi.Format^.biWidth;
 Avi.StreamInfo.rcFrame.Bottom := Avi.Format^.biHeight;
 if (AVI.FileCreateStream(Avi.AFile,
                          Avi.Stream,
                          Avi.StreamInfo) <> AVIERR_OK) then begin
  Showmessage('Konnte Avi-Stream nicht erstellen.');
  exit;
 end;
 InternalGetDIB(Picture.Handle,0,Avi.Format^,Avi.BitmapBits^,ColorDepth);
 if (AVI.StreamSetFormat(Avi.Stream,
                         0,
                         Avi.Format,
                         Avi.FormatSize) <> AVIERR_OK) then begin
  Showmessage('Konnte Avi-Format nicht erstellen.');
  exit;
 end;
 Avi.ColorDepth := ColorDepth;
 Avi.PictureCount := 0;
 Format := 1;
 Created := true;
end;

procedure PresAddPictureToVideo(Picture : TBitmap);
var
 nul : Longint;
begin
 if (not Created) then exit;
 case Format of
  1 : begin
   InternalGetDIB(Picture.Handle,0,Avi.Format^,Avi.BitmapBits^,Avi.ColorDepth);
   if AVI.StreamWrite(Avi.Stream,
                      Avi.PictureCount,
                      1,
                      Avi.BitmapBits,
                      Avi.BitmapSize,
                      AVIIF_KEYFRAME,
                      nul,
                      nul) <> AVIERR_OK then begin
    ShowMessage('Konnte Bild nicht zu Video hinzufügen. Aufzeichnung wird' +
     ' beendet.');
    PresStopRecording;
   end;
   Avi.PictureCount := Avi.PictureCount + 1;
  end;
 end;
end;

exports PresCreateAVIRecorder;
exports PresAddPictureToVideo;
exports PresStopRecording;

end.

Ist zwar auch 'ne Menge Code aber entscheidend sind die exportierten Methoden:
PresCreateAVIRecorder startet die Aufzeichnung und erwartet den Namen der zu speichernden AVI-Datei, das erste Bild als TBitmap, die Farbtiefe und wie viele Bilder pro Sekunde das Video haben soll.
PresAddPictureToVideo fügt dem Video ein neues Bild hinzu und erwartet dieses als TBitmap.
PresStopRecording beendet die Aufzeichnung.

Ich hab' so mal ein 5 Bilder langes Video mit 24 Bit Bitmap gemacht und hatte nach viel zulangen 10 Minuten ein fast 3 GB großes AVI, dass sich nicht abspielen ließ... :shock:

Wieso so groß? Das verwendete Bild hatte gerade mal 500KB :gruebel:

Nunja.. da das jetzt also geht - hat zufällig jemand ein Paar gute Links für komprimiertes AVI oder MPG, damit ich auch mehr Farbqualität bekomme?

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme