unit1.pas

ACKAGE INSTALL =============== NOTE: if you get an error when installing TVideoGrabber on the

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Jpeg, DirectDraw, ddutil, ExtCtrls; // <-- ddutil.pas 啊 货肺 眠啊凳

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    FDDraw: IDirectDraw7;
    FPrimarySurface: IDirectDrawSurface7;  // 橇扼捞赣府
    FBackSurface: IDirectDrawSurface7;     // 归滚欺
  public
    // 坷橇胶农赴 辑其捞胶
    OffScreenSurface: array[0..1] of IDirectDrawSurface7;

    function InitDirectDraw(): LongBool;
    procedure KillDirectDraw();
    procedure UpdateScreen();
    procedure MainLoof();
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// 坷橇胶农赴 辑其捞胶甫 积己茄促.
// sx, sy 积己瞪 辑其捞胶狼 啊肺,技肺 农扁
// VideoMemory 辑其捞胶啊 困摹且 皋葛府
function MakeSurface(MainDDraw: IDirectDraw7;
                     sx, sy: Longint;
                     VideoMemory: LongBool = True): IDirectDrawSurface7;
var
  Surface: IDirectDrawSurface7;
  ddsd: TDDSurfaceDesc2;
begin
   ZeroMemory(@ddsd, sizeof(ddsd));
   ddsd.dwSize  := sizeof(ddsd);
   ddsd.dwFlags := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH;

   // 坷橇胶农赴栏肺 汲沥窍绊, 厚叼坷 趣篮 矫胶袍 皋葛府捞 困摹窍霸 汲沥
   if VideoMemory then
   begin // 厚叼坷 皋葛府俊 困摹
      ddsd.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN or DDSCAPS_VIDEOMEMORY;
   end
   else begin  // 矫胶袍 皋葛府俊 困摹
     ddsd.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN or DDSCAPS_SYSTEMMEMORY;
   end;

   ddsd.dwWidth  := sx;
   ddsd.dwHeight := sy;

   if DD_OK <> MainDDraw.CreateSurface(ddsd, Surface, nil) then
   begin
     Result := nil;
     Exit;
   end;

   Result := Surface;
end;


// 辑其捞胶 副府令窍扁
// 辑其捞胶甫 nil肺 父甸扁 困秦 var肺 窍看促.
procedure KillSurface(var OutSurface: IDirectDrawSurface7);
begin
  if Pointer(OutSurface) <> nil then
  begin
    OutSurface._Release;
    Pointer(OutSurface) := nil;
  end;
end;


// 辑其捞胶俊 Jpeg 捞固瘤 颇老阑 免仿茄促.
function LoadJpegImage(var OutSurface: IDirectDrawSurface7;
                       img_x, img_y: Longint;
                       JpegName: String): LongBool;
var
  JpegImg: TJpegImage;
  BmpImg : TBitmap;
  DCSurface: HDC;
begin
  if not FileExists(JpegName) then
  begin
    Result := False;
    Exit;
  end;
  
  JpegImg := TJpegImage.Create;
  BmpImg  := TBitmap.Create;

  JpegImg.LoadFromFile(JpegName);
  // JpegImg俊 乐绰 捞固瘤甫 厚飘甘栏肺 官层坷绊.
  BmpImg.Assign(JpegImg);

  if (img_x = 0) or (img_y = 0) then
  begin
    img_x := JpegImg.Width;
    img_y := JpegImg.Height;
  end;

  // 辑其捞胶狼 DC甫 掘绊
  if DD_OK = OutSurface.GetDC(DCSurface) then
  begin
    // DC客 DC 康开阑 汗荤秦霖促.
    BitBlt(DCSurface, 0, 0, img_x, Img_y,
           BmpImg.Canvas.Handle, 0, 0, SRCCOPY);
    OutSurface.ReleaseDC(DCSurface)
  end;

  JpegImg.Free;
  BmpImg.Free;
  Result := True;
end;


// 辑其捞胶俊 咆胶飘甫 免仿窃
procedure DrawTextOut(OutSurface: IDirectDrawSurface7;
                      tx, ty: Longint;
                      tcolor: DWord;
                      tstr: String);
var
  DCSurface: HDC;
begin
  // 辑其捞胶甫 DC肺 掘绰促.
  if DD_OK = OutSurface.GetDC(DCSurface) then
  begin
    // 老窜 辑其捞胶狼 康开阑 DC肺 掘绢坷搁, GDI客 包访等 葛电 窃荐甸阑
    // 楷搬秦辑 荤侩且 荐 乐霸等促.
    SetBkMode(DCSurface, TRANSPARENT);
    SetTextColor(DCSurface, tcolor);
    TextOut( DCSurface, tx, ty, PChar(tstr), strlen(PChar(tstr)) );
    // DC甫 掘绊 怖 副府令甫 矫难拎具 茄促.
    OutSurface.ReleaseDC(DCSurface)
  end;
end;


// 辑其捞胶甫 漂沥祸栏肺 盲框
procedure BlackScreen(OutSurface: IDirectDrawSurface7; FillColor: DWord);
var
  ddbl: TDDBltFX;
begin
  ZeroMemory(@ddbl,sizeof(ddbl));
  ddbl.dwSize := sizeof(ddbl);
  ddbl.dwFillColor := FillColor; // 八沥祸

  // Blt绰 钎搁苞 钎搁阑 汗荤秦林绰 窃荐促.
  // 窍瘤父 咯扁急, 钎搁狼 傈眉农扁肺 祸阑 盲快绰 开劝阑 茄促.
  OutSurface.Blt(nil, nil, nil, DDBLT_COLORFILL, @ddbl);
end;


function TForm1.InitDirectDraw(): LongBool;
var
  hr: HResult;
  ddsd: TDDSurfaceDesc2;
  ddscaps: TDDSCaps2;
begin
  Result := False;

  // 促捞泛飘 靛肺快甫 积己
  hr := DirectDrawCreateEx(nil, FDDraw, IID_IDirectDraw7, nil);
  if hr <> DD_OK then   // 府畔罐篮 蔼捞 DD_OK啊 酒聪搁 俊矾.
    Exit;

  // 刀痢葛靛 汲沥
  // 傈眉拳搁 趣篮, 扩档快 葛靛肺 积己俊 静烙
  hr := FDDraw.SetCooperativeLevel(Handle, DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE);
  if hr <> DD_OK then
    Exit;

  // 秦惑档甫 官厕
  hr := FDDraw.SetDisplayMode(640, 480, 16, 0, 0);
  if hr <> DD_OK then
    Exit;

  // 辑其捞胶 积己俊 鞘夸茄 备炼眉 汲沥
  ZeroMemory(@ddsd, sizeOf(ddsd));
  // 备炼眉 农扁甫 持绢淋
  ddsd.dwSize := sizeof(ddsd);
  // Caps客 归滚欺 墨款磐甫 荤侩 啊瓷窍霸 窃
  ddsd.dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
  // 橇扼捞赣府 钎搁捞绊, 敲赋阑 瘤盔窍绊, 汗钦钎搁捞鄂吧 舅覆
  ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE  or DDSCAPS_FLIP or DDSCAPS_COMPLEX;
  // 归滚欺绰 1俺甫 啊柳促.
  ddsd.dwBackBufferCount := 1;

  // 橇扼捞赣府 辑其捞胶甫 积己
  hr := FDDraw.CreateSurface(ddsd, FPrimarySurface, nil);
  if hr <> DD_OK then
    Exit;

  // 归滚欺 积己俊 鞘夸茄 备炼眉 汲沥
  ZeroMemory(@ddscaps, sizeof(TDDSCaps2));
  // 捞 辑其捞胶绰 归滚欺鄂吧 舅覆
  ddscaps.dwCaps := DDSCAPS_BACKBUFFER;

  // 橇扼捞赣府 按眉甫 烹秦辑, 归滚欺甫 积己茄促.
  hr := FPrimarySurface.GetAttachedSurface(ddscaps, FBackSurface);
  if hr <> DD_OK then
    Exit;

  // ddutil.pas 蜡粗阑 烹秦, 辑其捞胶甫 积己窍绊, 厚飘甘阑 肺靛茄促.
  // 农扁甫 0, 0栏肺 林搁, 弊覆 农扁狼 嘎霸 辑其捞胶甫 积己窍绊, 肺靛茄促.
  OffScreenSurface[0] := ddutil.DDLoadBitmap(FDDraw, '1.bmp', 0, 0);
  if Pointer(OffScreenSurface[0]) = nil then
    Exit;

  DrawTextOut(OffScreenSurface[0], 0, 0, RGB(255, 0, 0), '1.bmp 涝聪促.');

  // 流立 父甸绢 夯 窃荐肺, 辑其捞胶甫 积己窍绊, Jpeg 颇老阑 肺靛茄促.
  OffScreenSurface[1] := MakeSurface(FDDraw, 320, 240);
  if Pointer(OffScreenSurface[1]) <> nil then
    if not LoadJpegImage(OffScreenSurface[1], 0, 0, '1.jpg') then
      Exit;

  DrawTextOut(OffScreenSurface[1], 0, 0, RGB(0, 255, 0), '1.jpg 涝聪促.');

  Result := True;
end;

procedure TForm1.KillDirectDraw();
begin

  // 葛电 辑其捞胶甸阑 副府令 窍扁
  KillSurface(OffScreenSurface[1]);
  KillSurface(OffScreenSurface[0]);
  KillSurface(FBackSurface);
  KillSurface(FPrimarySurface);

  // 积己等 按眉甸阑 副府令 矫挪促.
  // 积己等 按眉甸篮 积己等 鉴辑 馆措肺 副府令 矫难具 茄促.
  if Pointer(FDDraw) <> nil then
  begin
    // 副府令
    FDDraw._Release;
    // 副府令窍绊, 葛电 按眉绰 nil肺 父甸绢 林绢具茄促.
    Pointer(FDDraw) := nil;
  end;
end;

// 拳搁阑 诀单捞飘 茄促.
procedure TForm1.UpdateScreen();
begin
  // 归滚欺俊 乐绰 郴侩阑 快府啊 焊绊乐绰 橇扼捞赣府 钎搁栏肺 背眉 茄促.
  // (归滚欺绰 橇扼捞赣府 钎搁捞 登绊, 橇扼捞赣府 钎搁篮 归滚欺啊 等促)
  FPrimarySurface.Flip(nil, DDFLIP_WAIT);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // 傈眉 拳搁俊辑绰 坷弗率 盖困(芒 农扁 炼例, 辆丰 滚瓢..)俊 滚瓢甸捞 鞘夸绝扁
  // 锭巩俊, 汽阑 None 屈怕肺 官层霖促.
  BorderStyle := bsNone;

  if not InitDirectDraw() then
  begin
    //ShowMessage('傈眉拳搁 檬扁拳俊 角菩沁嚼聪促.');
    // 橇肺弊伐 辆丰 矫虐扁
    Application.Terminate;
  end;

  Timer1.Interval := 1;
  Timer1.Enabled := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Timer1.Enabled := False;
  KillDirectDraw();
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Close;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  MainLoof();
end;

procedure TForm1.MainLoof();
{$J+}
const
  ChangeBlt: LongBool = True;
  ImgPos   : Longint = 0;
{$J-}
var
  ImgRect: TRect;
begin
  if ChangeBlt then
  begin
    Inc(ImgPos);
    if imgPos >= 320 then ChangeBlt := False;
  end
  else begin
    Dec(ImgPos);
    if imgPos <= 0 then ChangeBlt := True;
  end;
  SetRect(ImgRect, ImgPos, 240, ImgPos+320, 480);

  // 傈眉甫 汗荤
  FBackSurface.BltFast(0, 0, OffScreenSurface[0], nil, DDBLTFAST_WAIT);

  // 漂沥 何盒俊 け汗荤
  FBackSurface.Blt(@imgrect, OffScreenSurface[1], nil, DDBLT_WAIT, nil);

  // 犬措/绵家秦辑 汗荤窍扁
  SetRect(ImgRect, 320-ImgPos, 0, ImgPos+320, 240);
  FBackSurface.Blt(@imgrect, OffScreenSurface[0], nil, DDBLT_WAIT, nil);

  DrawTextOut(FBackSurface, 100, 100, RGB(255,255,255),
              '促捞泛飘 靛肺快 抗力3涝聪促');
              
  UpdateScreen();
end;


end.