-------------关于抓屏（UP有分）---------------

看看你的代码？是不是rect选错位置了？

解决方案 »

  1.   

    Unit ScreenGrab;
    InterfaceUses
      Windows, SysUtils, Classes, Graphics,forms;Type
      tScreenGrab = Class(TComponent)
      Private
        Bmp: tBitMap;
        LeftSide: word;
        Top: word;
        TheWidth: Word;
        TheHeight: Word;
        filname: String;
        { Private declarations }
        Procedure SnapShot(xpos: integer; ypos: integer; Wid: integer; Height: integer; Var bmap: TBitMap);
        Function GetStartX: word;
        Function GetStartY: word;
        Function GetWidth: word;
        Function GetHeight: word;
        Function GetFileName: String;
        Function GetTheBMP: tBitMap;
        Procedure SetStartX(w: word);
        Procedure SetStartY(w: word);
        Procedure Setwidth(w: word);
        Procedure Setheight(w: word);
        Procedure SetFileName(s: String);
        Procedure SetTheBMP(B: tBitMap);
      Protected
        { Protected declarations }
        Constructor Create(AOwner: TComponent);
      Public
        { Public declarations }
        Procedure UnixName; // Gets a Unix timestamp style name for BMP
        Procedure GetFullScreen; // Gets just a screen
        Procedure GetActivewindow; // Gets just a screen
        Procedure GetBMP; // Gets specified Rect of screen
        Procedure SaveAsBMP; // Saves as bitmap to current name
      Published
        { Published declarations }
        Property StartX: word Read GetStartX Write SetStartX;
        Property StartY: word Read GetStartY Write SetStartY;
        Property width: word Read GetWidth Write SetWidth;
        Property height: word Read GetHeight Write SetHeight;
        Property FileName: String Read GetFileName Write SetFileName;
        Property TheBMP: tBitMap Read GetTheBMP Write SetTheBMP;
      End;Procedure Register;
    Function DelphiDateTimeToUnix(ConvDate: TdateTime): longint;
              // Converts Delphi date/time to Unix time stamp
    Function UnixToDelphiDateTime(USec: longint): TDateTime;
              // Converts Unix Timestamp to Delphi date/time
    Function UnixNow: LongInt;
              // Returns current unix timestamp
    Function Rpt(S: String; Rp: Byte): String;
              // Returns S repeated RP times
    Function PadNum(Const S: String; Size: Byte): String;
              // Pads '0' onto beginning of S, to Size length
    Function HasExtension(Fname: String; Var DotPos: Byte): Boolean;
              // checks to see if has extension
    Function DefaultExtension(FileName, Ext: String): String;
              // Puts a default extension on fileImplementation
    Const
      UnixStartDate     : tdatetime = 25568.0;  // for unix routinesProcedure Register;
    Begin
      RegisterComponents('EIS', [tScreenGrab]);
    End;Function DefaultExtension(FileName, Ext: String): String;
    Var
      DotPos            : Byte;
    Begin
      If HasExtension(FileName, DotPos) Then
        DefaultExtension := FileName
      Else
        DefaultExtension := FileName + Ext;
    End;Function HasExtension(Fname: String; Var DotPos: Byte): Boolean;
    Var
      Loop              : Word;
    Begin
      DotPos := 0;
      For Loop := Length(FName) Downto 1 Do
        If (FName[Loop] = '.') And (DotPos = 0) Then
          DotPos := Loop;
      HasExtension := (DotPos > 0) And (Pos('\', Copy(Fname, Succ(DotPos), 64)) =
        0);
    End;Function Rpt(S: String; Rp: Byte): String;
    Var
      TStr              : String;
      B                 : Byte;
    Begin
      TStr := '';
      If (Rp > 0) Then
        For B := 1 To Rp Do
          TStr := TStr + S;
      Rpt := TStr;
    End;Function PadNum(Const S: String; Size: Byte): String;
    Begin
      If (Length(S) < Size) Then
        PadNum := (Rpt('0', (Size - Length(S))) + S)
      Else
        PadNum := S;
    End;Function DelphiDateTimeToUnix(ConvDate: TdateTime): longint;
    Begin
      Try
        Result := round((ConvDate - UnixStartDate) * 86400);
      Except
        Result := 0;
      End;
    End;Function UnixToDelphiDateTime(USec: longint): TDateTime;
    Begin
      Try
        Result := (Usec / 86400) + UnixStartDate;
      Except
        Result := 0;
      End;
    End;Function UnixNow: LongInt;
    Begin
      UnixNow := DelphiDateTimeToUnix(Now);
    End;
    Constructor tScreenGrab.Create(AOwner: TComponent);
    Begin
      Inherited Create(aowner);
      BMP := Nil;
      width := screen.desktopwidth;
      height := screen.DesktopHeight;
      StartX := screen.DesktopLeft;
      StartY := Screen.Desktopheight;
      FilName := '';
    End;Function tScreenGrab.GetStartX: word;
    Begin
      result := leftside;
    End;Function tScreenGrab.GetStartY: word;
    Begin
      result := top;
    End;Function tScreenGrab.GetWidth: word;
    Begin
      result := TheWidth;
    End;Function tScreenGrab.GetHeight: word;
    Begin
      result := TheHeight;
    End;Procedure tScreenGrab.SetStartX(w: word);
    Begin
      LeftSide := w;
    End;Procedure tScreenGrab.SetStartY(w: word);
    Begin
      Top := W;
    End;Procedure tScreenGrab.Setwidth(w: word);
    Begin
      TheWidth := w;
    End;Procedure tScreenGrab.Setheight(w: word);
    Begin
      TheHeight := w;
    End;Procedure tScreenGrab.UnixName;
    Begin
      FileName := DefaultExtension(PadNum(IntToStr(UnixNow), 8), '.bmp');
    End;Function tScreenGrab.GetTheBMP: tBitMap;
    Begin
      Result := bmp;
    End;Procedure tScreenGrab.SetTheBMP(B: tBitMap);
    Begin
      bmp := B;
    End;Function tScreenGrab.GetFileName: String;
    Begin
      Result := Filname;
    End;Procedure tScreenGrab.SetFileName(s: String);
    Begin
      FilName := S;
    End;Procedure tScreenGrab.SnapShot(xpos: integer; ypos: integer; Wid: integer; Height: integer; Var bmap:
      TBitMap);
    Var
      dc                : HDC;
      lpPal             : PLOGPALETTE;
    Begin
      If ((Wid = 0) Or (Height = 0)) Then
        exit;
      bmap.Width := Wid;
      bmap.Height := Height;
      dc := GetDc(0);
      If (dc = 0) Then
        exit;  If (GetDeviceCaps(dc, RASTERCAPS) And
        RC_PALETTE = RC_PALETTE) Then
      Begin
        GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
        FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
        lpPal^.palVersion := $300;
        lpPal^.palNumEntries := GetSystemPaletteEntries(dc, 0, 256, lpPal^.palPalEntry);
        If (lpPal^.PalNumEntries <> 0) Then
          bmap.Palette := CreatePalette(lpPal^);
        FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
      End;
      BitBlt(bmap.Canvas.Handle, 0, 0, Wid, Height, Dc, xpos, ypos, SRCCOPY);
      ReleaseDc(0, dc);
    End;Procedure tScreenGrab.GetBMP;
    Begin
      Bmp := tBitMap.create;
      Try
        SnapShot(LeftSide, Top, TheWidth, Height, Bmp);
      Except
      End;
    End;Procedure tScreenGrab.GetFullScreen; // Gets just a screen
    Begin
      Bmp := tBitMap.create;
      Try
        SnapShot(screen.desktopLeft, Screen.DeskTopTop, Screen.DeskTopWidth, Screen.DeskTopHeight, Bmp);
      Except
      End;
    End;
    Procedure tScreenGrab.GetActiveWindow; // Gets just a screen
    var
      hwnd_active :hwnd;
      lpRect : Trect;
    Begin
      Bmp := tBitMap.create;
      hwnd_active := windows.GetActiveWindow();
      windows.GetWindowRect(hwnd_active,lpRect);
      Try
        SnapShot(lpRect.Left, lpRect.Top, lpRect.Right - lpRect.Left, lpRect.Bottom - lpRect.Top, Bmp);
      Except
      End;
    End;Procedure tScreenGrab.SaveAsBMP; // Saves as bitmap to current name
    Begin
      If FilName <> '' Then
      Try
        Bmp.SaveToFile(FilName);
      Except
      End;
    End;
    End.
      

  2.   

    Unit ScreenGrab;
    InterfaceUses
      Windows, SysUtils, Classes, Graphics,forms;Type
      tScreenGrab = Class(TComponent)
      Private
        Bmp: tBitMap;
        LeftSide: word;
        Top: word;
        TheWidth: Word;
        TheHeight: Word;
        filname: String;
        { Private declarations }
        Procedure SnapShot(xpos: integer; ypos: integer; Wid: integer; Height: integer; Var bmap: TBitMap);
        Function GetStartX: word;
        Function GetStartY: word;
        Function GetWidth: word;
        Function GetHeight: word;
        Function GetFileName: String;
        Function GetTheBMP: tBitMap;
        Procedure SetStartX(w: word);
        Procedure SetStartY(w: word);
        Procedure Setwidth(w: word);
        Procedure Setheight(w: word);
        Procedure SetFileName(s: String);
        Procedure SetTheBMP(B: tBitMap);
      Protected
        { Protected declarations }
        Constructor Create(AOwner: TComponent);
      Public
        { Public declarations }
        Procedure UnixName; // Gets a Unix timestamp style name for BMP
        Procedure GetFullScreen; // Gets just a screen
        Procedure GetActivewindow; // Gets just a screen
        Procedure GetBMP; // Gets specified Rect of screen
        Procedure SaveAsBMP; // Saves as bitmap to current name
      Published
        { Published declarations }
        Property StartX: word Read GetStartX Write SetStartX;
        Property StartY: word Read GetStartY Write SetStartY;
        Property width: word Read GetWidth Write SetWidth;
        Property height: word Read GetHeight Write SetHeight;
        Property FileName: String Read GetFileName Write SetFileName;
        Property TheBMP: tBitMap Read GetTheBMP Write SetTheBMP;
      End;Procedure Register;
    Function DelphiDateTimeToUnix(ConvDate: TdateTime): longint;
              // Converts Delphi date/time to Unix time stamp
    Function UnixToDelphiDateTime(USec: longint): TDateTime;
              // Converts Unix Timestamp to Delphi date/time
    Function UnixNow: LongInt;
              // Returns current unix timestamp
    Function Rpt(S: String; Rp: Byte): String;
              // Returns S repeated RP times
    Function PadNum(Const S: String; Size: Byte): String;
              // Pads '0' onto beginning of S, to Size length
    Function HasExtension(Fname: String; Var DotPos: Byte): Boolean;
              // checks to see if has extension
    Function DefaultExtension(FileName, Ext: String): String;
              // Puts a default extension on fileImplementation
    Const
      UnixStartDate     : tdatetime = 25568.0;  // for unix routinesProcedure Register;
    Begin
      RegisterComponents('EIS', [tScreenGrab]);
    End;Function DefaultExtension(FileName, Ext: String): String;
    Var
      DotPos            : Byte;
    Begin
      If HasExtension(FileName, DotPos) Then
        DefaultExtension := FileName
      Else
        DefaultExtension := FileName + Ext;
    End;Function HasExtension(Fname: String; Var DotPos: Byte): Boolean;
    Var
      Loop              : Word;
    Begin
      DotPos := 0;
      For Loop := Length(FName) Downto 1 Do
        If (FName[Loop] = '.') And (DotPos = 0) Then
          DotPos := Loop;
      HasExtension := (DotPos > 0) And (Pos('\', Copy(Fname, Succ(DotPos), 64)) =
        0);
    End;Function Rpt(S: String; Rp: Byte): String;
    Var
      TStr              : String;
      B                 : Byte;
    Begin
      TStr := '';
      If (Rp > 0) Then
        For B := 1 To Rp Do
          TStr := TStr + S;
      Rpt := TStr;
    End;Function PadNum(Const S: String; Size: Byte): String;
    Begin
      If (Length(S) < Size) Then
        PadNum := (Rpt('0', (Size - Length(S))) + S)
      Else
        PadNum := S;
    End;Function DelphiDateTimeToUnix(ConvDate: TdateTime): longint;
    Begin
      Try
        Result := round((ConvDate - UnixStartDate) * 86400);
      Except
        Result := 0;
      End;
    End;Function UnixToDelphiDateTime(USec: longint): TDateTime;
    Begin
      Try
        Result := (Usec / 86400) + UnixStartDate;
      Except
        Result := 0;
      End;
    End;Function UnixNow: LongInt;
    Begin
      UnixNow := DelphiDateTimeToUnix(Now);
    End;
    Constructor tScreenGrab.Create(AOwner: TComponent);
    Begin
      Inherited Create(aowner);
      BMP := Nil;
      width := screen.desktopwidth;
      height := screen.DesktopHeight;
      StartX := screen.DesktopLeft;
      StartY := Screen.Desktopheight;
      FilName := '';
    End;Function tScreenGrab.GetStartX: word;
    Begin
      result := leftside;
    End;Function tScreenGrab.GetStartY: word;
    Begin
      result := top;
    End;Function tScreenGrab.GetWidth: word;
    Begin
      result := TheWidth;
    End;Function tScreenGrab.GetHeight: word;
    Begin
      result := TheHeight;
    End;Procedure tScreenGrab.SetStartX(w: word);
    Begin
      LeftSide := w;
    End;Procedure tScreenGrab.SetStartY(w: word);
    Begin
      Top := W;
    End;Procedure tScreenGrab.Setwidth(w: word);
    Begin
      TheWidth := w;
    End;Procedure tScreenGrab.Setheight(w: word);
    Begin
      TheHeight := w;
    End;Procedure tScreenGrab.UnixName;
    Begin
      FileName := DefaultExtension(PadNum(IntToStr(UnixNow), 8), '.bmp');
    End;Function tScreenGrab.GetTheBMP: tBitMap;
    Begin
      Result := bmp;
    End;Procedure tScreenGrab.SetTheBMP(B: tBitMap);
    Begin
      bmp := B;
    End;Function tScreenGrab.GetFileName: String;
    Begin
      Result := Filname;
    End;Procedure tScreenGrab.SetFileName(s: String);
    Begin
      FilName := S;
    End;Procedure tScreenGrab.SnapShot(xpos: integer; ypos: integer; Wid: integer; Height: integer; Var bmap:
      TBitMap);
    Var
      dc                : HDC;
      lpPal             : PLOGPALETTE;
    Begin
      If ((Wid = 0) Or (Height = 0)) Then
        exit;
      bmap.Width := Wid;
      bmap.Height := Height;
      dc := GetDc(0);
      If (dc = 0) Then
        exit;  If (GetDeviceCaps(dc, RASTERCAPS) And
        RC_PALETTE = RC_PALETTE) Then
      Begin
        GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
        FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
        lpPal^.palVersion := $300;
        lpPal^.palNumEntries := GetSystemPaletteEntries(dc, 0, 256, lpPal^.palPalEntry);
        If (lpPal^.PalNumEntries <> 0) Then
          bmap.Palette := CreatePalette(lpPal^);
        FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
      End;
      BitBlt(bmap.Canvas.Handle, 0, 0, Wid, Height, Dc, xpos, ypos, SRCCOPY);
      ReleaseDc(0, dc);
    End;Procedure tScreenGrab.GetBMP;
    Begin
      Bmp := tBitMap.create;
      Try
        SnapShot(LeftSide, Top, TheWidth, Height, Bmp);
      Except
      End;
    End;Procedure tScreenGrab.GetFullScreen; // Gets just a screen
    Begin
      Bmp := tBitMap.create;
      Try
        SnapShot(screen.desktopLeft, Screen.DeskTopTop, Screen.DeskTopWidth, Screen.DeskTopHeight, Bmp);
      Except
      End;
    End;
    Procedure tScreenGrab.GetActiveWindow; // Gets just a screen
    var
      hwnd_active :hwnd;
      lpRect : Trect;
    Begin
      Bmp := tBitMap.create;
      hwnd_active := windows.GetActiveWindow();
      windows.GetWindowRect(hwnd_active,lpRect);
      Try
        SnapShot(lpRect.Left, lpRect.Top, lpRect.Right - lpRect.Left, lpRect.Bottom - lpRect.Top, Bmp);
      Except
      End;
    End;Procedure tScreenGrab.SaveAsBMP; // Saves as bitmap to current name
    Begin
      If FilName <> '' Then
      Try
        Bmp.SaveToFile(FilName);
      Except
      End;
    End;
    End.
      

  3.   

    将AVI文件的第一桢图象读取出来并转换为位图：
    function GetAviFrame(AviFilename : String; Index: Integer; var bmp: TBitmap): boolean;
    说明:
    avifilename: avi文件名
    index: 要取的桢号
    bmp: 存放返回图象, 如果为nil则自动建立一个bitmap. 如果存在则按bmp
            定义的大小存放stretch后的图象.
    返回值: true 成功, false 失败.代码:uses windows, graphics;interfaceconst
      streamtypeAUDIO : longint = $73647561;
      streamtypeVIDEO : longint = $73646976;type
      TAVIStream = record
        fccType    : longint;
        fccHandler : longint;
        dwFlags    : longint;
        dwCaps     : longint;
        wPriority  : word;
        wLanguage  : word;
        dwScale    : longint;
        dwRate     : longint;
        dwStart    : longint;
        dwLength   : longint;
        dwInitialFrames : longint;
        dwSuggestedBufferSize : longint;
        dwQuality    : longint;
        dwSampleSize : longint;
        rcFrame      : TRect;
        dwEditCount  : longint;
        dwFormatChangeCount : longint;
        Name : array [0..64] of char;
      end;  PAVIStream = ^TAVIStream;  PAVIFile = pointer;  TAVIFileInfo = record
        dwMaxBytesPerSec : longint;
        dwFlags          : longint;
        dwCaps           : longint;
        dwStreams        : longint;
        dwSuggestedBufferSize : longint;    dwWidth          : longint;
        dwHeight         : longint;    dwScale          : longint;
        dwRate           : longint;
        dwLength         : longint;    dwEditCount      : longint;    szFileType       : array[0..63] of char;
      end;  PAVIFileInfo = ^TAVIFileInfo;  TAVIStreamInfo = record
        fccType               : longint;
        fccHandler            : longint;
        dwFlags               : longint;
        dwCaps                : longint;
        wPriority             : word;
        wLanguage             : word;
        dwScale               : longint;
        dwRate                : longint;
        dwStart               : longint;
        dwLength              : longint;
        dwInitialFrames       : longint;
        dwSuggestedBufferSize : longint;
        dwQuality             : longint;
        dwSampleSize          : longint;
        rcFrame               : TRect;
        dwEditCount           : longint;
        dwFormatChangeCount   : longint;
        szName  : array[0..63] of char;
      end;  PAVIStreamInfo = ^TAVIStreamInfo;function  AVIFileOpen(avifile : pointer; filename : pchar; mode : integer;
                       CLSID : pointer) : integer; stdcall; external 'avifil32.dll' index 16;function  AVIFileRelease(avifile : pointer) : longint; stdcall; external 'avifil32.dll' index 20;function  AVIFileGetStream(avifile : pointer; avistream : PAVIStream;
                               streamtype : longint; lParam : longint) : integer; stdcall; external 'avifil32.dll' index 11;function  AVIStreamGetFrameOpen(avistream : PAVIStream; bitmapwanted : pointer) : pointer; stdcall; external 'avifil32.dll' index 42;procedure AVIStreamGetFrameClose(pget : pointer); stdcall; external 'avifil32.dll' index 41;function  AVIStreamGetFrame(getframe : pointer; position : longint) : pointer; stdcall; external 'avifil32.dll' index 40;procedure AVIStreamRelease(avistream : PAVIStream); stdcall; external 'avifil32.dll' index 53;function  AVIStreamInfo(pstream : PAVIStream; psi : PAVISTREAMINFO; lsize : longint) : integer; stdcall; external 'avifil32.dll' index 44;function GetAviFrame(AviFilename : String; Index: Integer; var bmp: TBitmap): boolean;implementationfunction GetAviFrame(AviFilename : String; Index: Integer; var bmp: TBitmap): boolean;
    var
      FAviFile : Pointer;
      FVideoStream : Pointer;
      FGetFrame : Pointer;
      info : TAVIStreamInfo;
      FFrameWidth, FFrameHeight : Integer;
      FStartFrame, FStopFrame : Integer;
      image : PBitmapInfoHeader;
      imagestart : Integer;
    begin
      result := false;
      if (AVIFileOpen(@favifile, pchar(AviFileName), 0, nil) <> 0) then
        exit;  if (AVIFileGetStream(favifile, @fvideostream, streamtypeVIDEO, 0) <> 0) then
      begin
          AVIFileRelease(favifile);
          exit;
      end;  AVIStreamInfo(fvideostream, @info, sizeof(info));
      with info do
      begin
          fFrameWidth := rcframe.right - rcframe.left;
          fFrameHeight := rcframe.bottom - rcframe.top;
          fStartFrame := dwStart;
          fStopFrame := dwLength - 1;
      end;  if (index <fstartframe) or (index > fstopframe) then
      begin
          AVIStreamRelease(fvideostream);
          AVIFileRelease(favifile);
          exit;
      end;  fgetframe := AVIStreamGetFrameOpen(fvideostream, nil);
      if (fgetframe = nil)  then
      begin
          AVIStreamRelease(fvideostream);
          AVIFileRelease(favifile);
          exit;
      end;  image := AVIStreamGetFrame(fgetframe, Index);
      if assigned(image) then
      begin
          if not assigned(bmp) then
          begin
            bmp := tbitmap.create;
            bmp.width := fframewidth;
            bmp.height := fframeheight;
          end
          else if bmp.empty then
          begin
             bmp.width := fframewidth;
             bmp.height := fframeheight;
          end;
          imagestart := image^.biSize + image^.biClrUsed * 4;
          StretchDIBits(bmp.canvas.handle, 0, 0, bmp.width, bmp.height,
                           0, 0, fframewidth, fframeheight,
                           pchar(image) + imagestart,
                           TBitmapInfo(image^), 0, SRCCOPY);
          result := true;
      end;  AVIStreamGetFrameClose(fgetframe);
      AVIStreamRelease(fvideostream);
      AVIFileRelease(favifile);
    end;end.
      

  4.   

    将AVI文件的第一桢图象读取出来并转换为位图：
    function GetAviFrame(AviFilename : String; Index: Integer; var bmp: TBitmap): boolean;
    说明:
    avifilename: avi文件名
    index: 要取的桢号
    bmp: 存放返回图象, 如果为nil则自动建立一个bitmap. 如果存在则按bmp
            定义的大小存放stretch后的图象.
    返回值: true 成功, false 失败.代码:uses windows, graphics;interfaceconst
      streamtypeAUDIO : longint = $73647561;
      streamtypeVIDEO : longint = $73646976;type
      TAVIStream = record
        fccType    : longint;
        fccHandler : longint;
        dwFlags    : longint;
        dwCaps     : longint;
        wPriority  : word;
        wLanguage  : word;
        dwScale    : longint;
        dwRate     : longint;
        dwStart    : longint;
        dwLength   : longint;
        dwInitialFrames : longint;
        dwSuggestedBufferSize : longint;
        dwQuality    : longint;
        dwSampleSize : longint;
        rcFrame      : TRect;
        dwEditCount  : longint;
        dwFormatChangeCount : longint;
        Name : array [0..64] of char;
      end;  PAVIStream = ^TAVIStream;  PAVIFile = pointer;  TAVIFileInfo = record
        dwMaxBytesPerSec : longint;
        dwFlags          : longint;
        dwCaps           : longint;
        dwStreams        : longint;
        dwSuggestedBufferSize : longint;    dwWidth          : longint;
        dwHeight         : longint;    dwScale          : longint;
        dwRate           : longint;
        dwLength         : longint;    dwEditCount      : longint;    szFileType       : array[0..63] of char;
      end;  PAVIFileInfo = ^TAVIFileInfo;  TAVIStreamInfo = record
        fccType               : longint;
        fccHandler            : longint;
        dwFlags               : longint;
        dwCaps                : longint;
        wPriority             : word;
        wLanguage             : word;
        dwScale               : longint;
        dwRate                : longint;
        dwStart               : longint;
        dwLength              : longint;
        dwInitialFrames       : longint;
        dwSuggestedBufferSize : longint;
        dwQuality             : longint;
        dwSampleSize          : longint;
        rcFrame               : TRect;
        dwEditCount           : longint;
        dwFormatChangeCount   : longint;
        szName  : array[0..63] of char;
      end;  PAVIStreamInfo = ^TAVIStreamInfo;function  AVIFileOpen(avifile : pointer; filename : pchar; mode : integer;
                       CLSID : pointer) : integer; stdcall; external 'avifil32.dll' index 16;function  AVIFileRelease(avifile : pointer) : longint; stdcall; external 'avifil32.dll' index 20;function  AVIFileGetStream(avifile : pointer; avistream : PAVIStream;
                               streamtype : longint; lParam : longint) : integer; stdcall; external 'avifil32.dll' index 11;function  AVIStreamGetFrameOpen(avistream : PAVIStream; bitmapwanted : pointer) : pointer; stdcall; external 'avifil32.dll' index 42;procedure AVIStreamGetFrameClose(pget : pointer); stdcall; external 'avifil32.dll' index 41;function  AVIStreamGetFrame(getframe : pointer; position : longint) : pointer; stdcall; external 'avifil32.dll' index 40;procedure AVIStreamRelease(avistream : PAVIStream); stdcall; external 'avifil32.dll' index 53;function  AVIStreamInfo(pstream : PAVIStream; psi : PAVISTREAMINFO; lsize : longint) : integer; stdcall; external 'avifil32.dll' index 44;function GetAviFrame(AviFilename : String; Index: Integer; var bmp: TBitmap): boolean;implementationfunction GetAviFrame(AviFilename : String; Index: Integer; var bmp: TBitmap): boolean;
    var
      FAviFile : Pointer;
      FVideoStream : Pointer;
      FGetFrame : Pointer;
      info : TAVIStreamInfo;
      FFrameWidth, FFrameHeight : Integer;
      FStartFrame, FStopFrame : Integer;
      image : PBitmapInfoHeader;
      imagestart : Integer;
    begin
      result := false;
      if (AVIFileOpen(@favifile, pchar(AviFileName), 0, nil) <> 0) then
        exit;  if (AVIFileGetStream(favifile, @fvideostream, streamtypeVIDEO, 0) <> 0) then
      begin
          AVIFileRelease(favifile);
          exit;
      end;  AVIStreamInfo(fvideostream, @info, sizeof(info));
      with info do
      begin
          fFrameWidth := rcframe.right - rcframe.left;
          fFrameHeight := rcframe.bottom - rcframe.top;
          fStartFrame := dwStart;
          fStopFrame := dwLength - 1;
      end;  if (index <fstartframe) or (index > fstopframe) then
      begin
          AVIStreamRelease(fvideostream);
          AVIFileRelease(favifile);
          exit;
      end;  fgetframe := AVIStreamGetFrameOpen(fvideostream, nil);
      if (fgetframe = nil)  then
      begin
          AVIStreamRelease(fvideostream);
          AVIFileRelease(favifile);
          exit;
      end;  image := AVIStreamGetFrame(fgetframe, Index);
      if assigned(image) then
      begin
          if not assigned(bmp) then
          begin
            bmp := tbitmap.create;
            bmp.width := fframewidth;
            bmp.height := fframeheight;
          end
          else if bmp.empty then
          begin
             bmp.width := fframewidth;
             bmp.height := fframeheight;
          end;
          imagestart := image^.biSize + image^.biClrUsed * 4;
          StretchDIBits(bmp.canvas.handle, 0, 0, bmp.width, bmp.height,
                           0, 0, fframewidth, fframeheight,
                           pchar(image) + imagestart,
                           TBitmapInfo(image^), 0, SRCCOPY);
          result := true;
      end;  AVIStreamGetFrameClose(fgetframe);
      AVIStreamRelease(fvideostream);
      AVIFileRelease(favifile);
    end;end.
      

  5.   

    将AVI文件的第一桢图象读取出来并转换为位图：
    function GetAviFrame(AviFilename : String; Index: Integer; var bmp: TBitmap): boolean;
    说明:
    avifilename: avi文件名
    index: 要取的桢号
    bmp: 存放返回图象, 如果为nil则自动建立一个bitmap. 如果存在则按bmp
            定义的大小存放stretch后的图象.
    返回值: true 成功, false 失败.代码:uses windows, graphics;interfaceconst
      streamtypeAUDIO : longint = $73647561;
      streamtypeVIDEO : longint = $73646976;type
      TAVIStream = record
        fccType    : longint;
        fccHandler : longint;
        dwFlags    : longint;
        dwCaps     : longint;
        wPriority  : word;
        wLanguage  : word;
        dwScale    : longint;
        dwRate     : longint;
        dwStart    : longint;
        dwLength   : longint;
        dwInitialFrames : longint;
        dwSuggestedBufferSize : longint;
        dwQuality    : longint;
        dwSampleSize : longint;
        rcFrame      : TRect;
        dwEditCount  : longint;
        dwFormatChangeCount : longint;
        Name : array [0..64] of char;
      end;  PAVIStream = ^TAVIStream;  PAVIFile = pointer;  TAVIFileInfo = record
        dwMaxBytesPerSec : longint;
        dwFlags          : longint;
        dwCaps           : longint;
        dwStreams        : longint;
        dwSuggestedBufferSize : longint;    dwWidth          : longint;
        dwHeight         : longint;    dwScale          : longint;
        dwRate           : longint;
        dwLength         : longint;    dwEditCount      : longint;    szFileType       : array[0..63] of char;
      end;  PAVIFileInfo = ^TAVIFileInfo;  TAVIStreamInfo = record
        fccType               : longint;
        fccHandler            : longint;
        dwFlags               : longint;
        dwCaps                : longint;
        wPriority             : word;
        wLanguage             : word;
        dwScale               : longint;
        dwRate                : longint;
        dwStart               : longint;
        dwLength              : longint;
        dwInitialFrames       : longint;
        dwSuggestedBufferSize : longint;
        dwQuality             : longint;
        dwSampleSize          : longint;
        rcFrame               : TRect;
        dwEditCount           : longint;
        dwFormatChangeCount   : longint;
        szName  : array[0..63] of char;
      end;  PAVIStreamInfo = ^TAVIStreamInfo;function  AVIFileOpen(avifile : pointer; filename : pchar; mode : integer;
                       CLSID : pointer) : integer; stdcall; external 'avifil32.dll' index 16;function  AVIFileRelease(avifile : pointer) : longint; stdcall; external 'avifil32.dll' index 20;function  AVIFileGetStream(avifile : pointer; avistream : PAVIStream;
                               streamtype : longint; lParam : longint) : integer; stdcall; external 'avifil32.dll' index 11;function  AVIStreamGetFrameOpen(avistream : PAVIStream; bitmapwanted : pointer) : pointer; stdcall; external 'avifil32.dll' index 42;procedure AVIStreamGetFrameClose(pget : pointer); stdcall; external 'avifil32.dll' index 41;function  AVIStreamGetFrame(getframe : pointer; position : longint) : pointer; stdcall; external 'avifil32.dll' index 40;procedure AVIStreamRelease(avistream : PAVIStream); stdcall; external 'avifil32.dll' index 53;function  AVIStreamInfo(pstream : PAVIStream; psi : PAVISTREAMINFO; lsize : longint) : integer; stdcall; external 'avifil32.dll' index 44;function GetAviFrame(AviFilename : String; Index: Integer; var bmp: TBitmap): boolean;implementationfunction GetAviFrame(AviFilename : String; Index: Integer; var bmp: TBitmap): boolean;
    var
      FAviFile : Pointer;
      FVideoStream : Pointer;
      FGetFrame : Pointer;
      info : TAVIStreamInfo;
      FFrameWidth, FFrameHeight : Integer;
      FStartFrame, FStopFrame : Integer;
      image : PBitmapInfoHeader;
      imagestart : Integer;
    begin
      result := false;
      if (AVIFileOpen(@favifile, pchar(AviFileName), 0, nil) <> 0) then
        exit;  if (AVIFileGetStream(favifile, @fvideostream, streamtypeVIDEO, 0) <> 0) then
      begin
          AVIFileRelease(favifile);
          exit;
      end;  AVIStreamInfo(fvideostream, @info, sizeof(info));
      with info do
      begin
          fFrameWidth := rcframe.right - rcframe.left;
          fFrameHeight := rcframe.bottom - rcframe.top;
          fStartFrame := dwStart;
          fStopFrame := dwLength - 1;
      end;  if (index <fstartframe) or (index > fstopframe) then
      begin
          AVIStreamRelease(fvideostream);
          AVIFileRelease(favifile);
          exit;
      end;  fgetframe := AVIStreamGetFrameOpen(fvideostream, nil);
      if (fgetframe = nil)  then
      begin
          AVIStreamRelease(fvideostream);
          AVIFileRelease(favifile);
          exit;
      end;  image := AVIStreamGetFrame(fgetframe, Index);
      if assigned(image) then
      begin
          if not assigned(bmp) then
          begin
            bmp := tbitmap.create;
            bmp.width := fframewidth;
            bmp.height := fframeheight;
          end
          else if bmp.empty then
          begin
             bmp.width := fframewidth;
             bmp.height := fframeheight;
          end;
          imagestart := image^.biSize + image^.biClrUsed * 4;
          StretchDIBits(bmp.canvas.handle, 0, 0, bmp.width, bmp.height,
                           0, 0, fframewidth, fframeheight,
                           pchar(image) + imagestart,
                           TBitmapInfo(image^), 0, SRCCOPY);
          result := true;
      end;  AVIStreamGetFrameClose(fgetframe);
      AVIStreamRelease(fvideostream);
      AVIFileRelease(favifile);
    end;end.
      

  6.   

    Unit ScreenGrab;
    InterfaceUses
      Windows, SysUtils, Classes, Graphics,forms;Type
      tScreenGrab = Class(TComponent)
      Private
        Bmp: tBitMap;
        LeftSide: word;
        Top: word;
        TheWidth: Word;
        TheHeight: Word;
        filname: String;
        { Private declarations }
        Procedure SnapShot(xpos: integer; ypos: integer; Wid: integer; Height: integer; Var bmap: TBitMap);
        Function GetStartX: word;
        Function GetStartY: word;
        Function GetWidth: word;
        Function GetHeight: word;
        Function GetFileName: String;
        Function GetTheBMP: tBitMap;
        Procedure SetStartX(w: word);
        Procedure SetStartY(w: word);
        Procedure Setwidth(w: word);
        Procedure Setheight(w: word);
        Procedure SetFileName(s: String);
        Procedure SetTheBMP(B: tBitMap);
      Protected
        { Protected declarations }
        Constructor Create(AOwner: TComponent);
      Public
        { Public declarations }
        Procedure UnixName; // Gets a Unix timestamp style name for BMP
        Procedure GetFullScreen; // Gets just a screen
        Procedure GetActivewindow; // Gets just a screen
        Procedure GetBMP; // Gets specified Rect of screen
        Procedure SaveAsBMP; // Saves as bitmap to current name
      Published
        { Published declarations }
        Property StartX: word Read GetStartX Write SetStartX;
        Property StartY: word Read GetStartY Write SetStartY;
        Property width: word Read GetWidth Write SetWidth;
        Property height: word Read GetHeight Write SetHeight;
        Property FileName: String Read GetFileName Write SetFileName;
        Property TheBMP: tBitMap Read GetTheBMP Write SetTheBMP;
      End;Procedure Register;
    Function DelphiDateTimeToUnix(ConvDate: TdateTime): longint;
              // Converts Delphi date/time to Unix time stamp
    Function UnixToDelphiDateTime(USec: longint): TDateTime;
              // Converts Unix Timestamp to Delphi date/time
    Function UnixNow: LongInt;
              // Returns current unix timestamp
    Function Rpt(S: String; Rp: Byte): String;
              // Returns S repeated RP times
    Function PadNum(Const S: String; Size: Byte): String;
              // Pads '0' onto beginning of S, to Size length
    Function HasExtension(Fname: String; Var DotPos: Byte): Boolean;
              // checks to see if has extension
    Function DefaultExtension(FileName, Ext: String): String;
              // Puts a default extension on fileImplementation
    Const
      UnixStartDate     : tdatetime = 25568.0;  // for unix routinesProcedure Register;
    Begin
      RegisterComponents('EIS', [tScreenGrab]);
    End;Function DefaultExtension(FileName, Ext: String): String;
    Var
      DotPos            : Byte;
    Begin
      If HasExtension(FileName, DotPos) Then
        DefaultExtension := FileName
      Else
        DefaultExtension := FileName + Ext;
    End;Function HasExtension(Fname: String; Var DotPos: Byte): Boolean;
    Var
      Loop              : Word;
    Begin
      DotPos := 0;
      For Loop := Length(FName) Downto 1 Do
        If (FName[Loop] = '.') And (DotPos = 0) Then
          DotPos := Loop;
      HasExtension := (DotPos > 0) And (Pos('\', Copy(Fname, Succ(DotPos), 64)) =
        0);
    End;Function Rpt(S: String; Rp: Byte): String;
    Var
      TStr              : String;
      B                 : Byte;
    Begin
      TStr := '';
      If (Rp > 0) Then
        For B := 1 To Rp Do
          TStr := TStr + S;
      Rpt := TStr;
    End;Function PadNum(Const S: String; Size: Byte): String;
    Begin
      If (Length(S) < Size) Then
        PadNum := (Rpt('0', (Size - Length(S))) + S)
      Else
        PadNum := S;
    End;Function DelphiDateTimeToUnix(ConvDate: TdateTime): longint;
    Begin
      Try
        Result := round((ConvDate - UnixStartDate) * 86400);
      Except
        Result := 0;
      End;
    End;Function UnixToDelphiDateTime(USec: longint): TDateTime;
    Begin
      Try
        Result := (Usec / 86400) + UnixStartDate;
      Except
        Result := 0;
      End;
    End;Function UnixNow: LongInt;
    Begin
      UnixNow := DelphiDateTimeToUnix(Now);
    End;
    Constructor tScreenGrab.Create(AOwner: TComponent);
    Begin
      Inherited Create(aowner);
      BMP := Nil;
      width := screen.desktopwidth;
      height := screen.DesktopHeight;
      StartX := screen.DesktopLeft;
      StartY := Screen.Desktopheight;
      FilName := '';
    End;Function tScreenGrab.GetStartX: word;
    Begin
      result := leftside;
    End;Function tScreenGrab.GetStartY: word;
    Begin
      result := top;
    End;Function tScreenGrab.GetWidth: word;
    Begin
      result := TheWidth;
    End;Function tScreenGrab.GetHeight: word;
    Begin
      result := TheHeight;
    End;Procedure tScreenGrab.SetStartX(w: word);
    Begin
      LeftSide := w;
    End;Procedure tScreenGrab.SetStartY(w: word);
    Begin
      Top := W;
    End;Procedure tScreenGrab.Setwidth(w: word);
    Begin
      TheWidth := w;
    End;Procedure tScreenGrab.Setheight(w: word);
    Begin
      TheHeight := w;
    End;Procedure tScreenGrab.UnixName;
    Begin
      FileName := DefaultExtension(PadNum(IntToStr(UnixNow), 8), '.bmp');
    End;Function tScreenGrab.GetTheBMP: tBitMap;
    Begin
      Result := bmp;
    End;Procedure tScreenGrab.SetTheBMP(B: tBitMap);
    Begin
      bmp := B;
    End;Function tScreenGrab.GetFileName: String;
    Begin
      Result := Filname;
    End;Procedure tScreenGrab.SetFileName(s: String);
    Begin
      FilName := S;
    End;Procedure tScreenGrab.SnapShot(xpos: integer; ypos: integer; Wid: integer; Height: integer; Var bmap:
      TBitMap);
    Var
      dc                : HDC;
      lpPal             : PLOGPALETTE;
    Begin
      If ((Wid = 0) Or (Height = 0)) Then
        exit;
      bmap.Width := Wid;
      bmap.Height := Height;
      dc := GetDc(0);
      If (dc = 0) Then
        exit;  If (GetDeviceCaps(dc, RASTERCAPS) And
        RC_PALETTE = RC_PALETTE) Then
      Begin
        GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
        FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
        lpPal^.palVersion := $300;
        lpPal^.palNumEntries := GetSystemPaletteEntries(dc, 0, 256, lpPal^.palPalEntry);
        If (lpPal^.PalNumEntries <> 0) Then
          bmap.Palette := CreatePalette(lpPal^);
        FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
      End;
      BitBlt(bmap.Canvas.Handle, 0, 0, Wid, Height, Dc, xpos, ypos, SRCCOPY);
      ReleaseDc(0, dc);
    End;Procedure tScreenGrab.GetBMP;
    Begin
      Bmp := tBitMap.create;
      Try
        SnapShot(LeftSide, Top, TheWidth, Height, Bmp);
      Except
      End;
    End;Procedure tScreenGrab.GetFullScreen; // Gets just a screen
    Begin
      Bmp := tBitMap.create;
      Try
        SnapShot(screen.desktopLeft, Screen.DeskTopTop, Screen.DeskTopWidth, Screen.DeskTopHeight, Bmp);
      Except
      End;
    End;
    Procedure tScreenGrab.GetActiveWindow; // Gets just a screen
    var
      hwnd_active :hwnd;
      lpRect : Trect;
    Begin
      Bmp := tBitMap.create;
      hwnd_active := windows.GetActiveWindow();
      windows.GetWindowRect(hwnd_active,lpRect);
      Try
        SnapShot(lpRect.Left, lpRect.Top, lpRect.Right - lpRect.Left, lpRect.Bottom - lpRect.Top, Bmp);
      Except
      End;
    End;Procedure tScreenGrab.SaveAsBMP; // Saves as bitmap to current name
    Begin
      If FilName <> '' Then
      Try
        Bmp.SaveToFile(FilName);
      Except
      End;
    End;
    End.
      

  7.   

    好象，那个avi是捉不住的阿，一般的canvas是不管用的阿
      

  8.   

    那个window是用的DirectX，一般的Canvas抓不住的。
      

  9.   

    我告诉你，你用windows media player暂停然后print screen的就是黑屏，但你用解霸抓的就是图片。