丛书上抄来的!~谁能帮我调通!~unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DXClass, DXDraws, DirectX;type
  TForm1 = class(TForm)
    DXTimer1: TDXTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure DXTimer1Activate(Sender: TObject);
  private
    FDirectDraw: IDirectDraw;
    FPrimarySurface: IDirectDrawSurface;
    FBackSurface: IDirectDrawSurface;
    FActive: Boolean;
    FPhase: Byte;
    FFrontMsg,FBackMsg: String;
    procedure Start;
    { Private declarations }
  public
    { Public declarations }
  end;const
  AFileName: String = 'c:\debug.txt';var
  Form1: TForm1;
  DebugFile: TextFile;implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
  width := 800;
  height := 600;
  FdirectDraw := nil;
  Fphase := 0;
  FActive := False;
  FFrontMsg := 'Front buffer (按F12或者Esc退出)';
  FBackMsg := 'Back buffer (按F12或者Esc退出)';
end;procedure TForm1.Start;
var
  hr: Hresult;
  SurfaceDesc: TDDSurfaceDesc;
  DDSCaps: TDDScaps;
  DC: HDC;
begin
  hr := DirectDrawCreate(nil,FDirectDraw,nil);
  if(hr = DD_OK) then
  begin
    hr := FDirectDraw.SetCooperativeLevel(Handle,DDSCL_EXCLUSIVE or DDSCL_FULLSCREEN);    if(hr = DD_OK) then
    begin
      hr := FDirectDraw.SetDisplayMode(640,480,8);      if(hr = DD_OK) then
      begin
        SurfaceDesc.dwSize := sizeof(SurfaceDesc);
        SurfaceDesc.dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
        SurfaceDesc.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or DDSCAPS_COMPLEX;
        SurfaceDesc.dwBackBufferCount := 1;
        hr := FDirectDraw.CreateSurface(SurfaceDesc,FPrimarySurface,nil);        if(hr = DD_OK) then
        begin
          ddscaps.dwCaps := DDSCAPS_BACKBUFFER;
          hr := FPrimarySurface.GetAttachedSurface(ddscaps,FBackSurface);          if(hr = DD_OK) then
          begin
            if(FPrimarySurface.GetDC(DC) = DD_OK) then
            begin
              Setbkcolor(DC, RGB(0, 0, 255));
              SetTextColor(DC, RGB(255, 255, 0));
              TextOut(DC, 0, 0, Pchar(FFrontMsg), Length(FFrontMsg));
              FPrimarySurface.ReleaseDC(DC);
            end;            if(FPrimarySurface.GetDC(DC) = DD_OK) then
            begin
              Setbkcolor(DC, RGB(0, 0, 255));
              SetTextColor(DC, RGB(255, 255, 0));
              TextOut(DC, 0, 0, Pchar(FBackMsg), Length(FBackMsg));
              FPrimarySurface.ReleaseDC(DC);
            end;            FActive := True;
            DXTimer1.Enabled := True;
            Exit;
          end;
        end;
      end;
    end;
  end;
  //MessageBox(Handle, Pchar(ForMat('Direct Draw Init Failed %x')),'ERROR',MB_OK);
  SHowMessage('Direct Draw Init Failed %X');
  Close();
end;procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_F3: Start();
    VK_ESCAPE,VK_F12:
    begin
      DXTimer1.Enabled := False;
      Close;
    end;
  end;
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
  if FDirectDraw <> nil then
  begin
    FDirectDraw.FlipToGDISurface;
    FDirectDraw.SetCooperativeLevel(Handle,DDSCL_NORMAL);
    if FbackSurface <> nil then
      FBackSurface := nil;
    if FPrimarySurface <> nil then
      FprimarySurface := nil;
    FdirectDraw := nil;
  end;
end;procedure TForm1.FormPaint(Sender: TObject);
const
  Msg = 'Page Flippiing Test: Press F3 to strt, F12 or Esc to Exit';
var
  rc: TRect;
  size: TSize;
  DC: HDC;
begin
  if not(FActive) then
  begin
    DC := GetDC(Handle);
    rc := GetClientRect;
    WriteLn(DebugFile, 'Left:', rc.Left, ' Top:', rc.Top, 'Right:', rc.Right, 'Bottom:', rc.Bottom);
    GetTextExtentpoint(DC, Msg, Length(Msg), size);
    SetBkcolor(DC, RGB(0, 0, 0));
    settextcolor(DC,RGB(255, 255, 0));
    TextOut(DC, (rc.Right - size.cx) div 2, (rc.Bottom - size.cy) div 2, Pchar(Msg), Length(Msg));
    ReleaseDc(Handle, DC);
  end;end;procedure TForm1.DXTimer1Activate(Sender: TObject);
var
  Dc: HDC;
  hr: HResult;
begin
  if (FBackSurface.GetDC(DC) = DD_OK) then
  begin
    if FPhase <> 0 then
    begin
      SetBkColor(DC, RGB(0, 0, 255));
      SetTextColor(DC, RGB(255, 255, 0));
      TextOut(Dc, 0, 0, PChar(FFrontMsg), Length(FFrontMsg));
      FPhase := 0;
    end
    else
    begin
      SetBkColor(DC, RGB(0, 0, 255));
      SetTextColor(DC, RGB(0, 255, 255));
      TextOut(Dc, 0, 0, PChar(FBackMsg), Length(FBackMsg));
      FPhase := 1;
    end;
    FBackSurface.ReleaseDC(DC);
  end;  while (True) do
  begin
    hr := FprimarySurface.Flip(nil, 0);    if (hr = DD_ok) then
      break;    if(hr = DDERR_SURFACELOST) then
    begin
      if(hr <> DD_OK) then
        break;
    end;    if (hr <> DDERR_WASSTILLDRAWING) then
      break;
  end;end;initialization
  AssignFile(DebugFile,AfileName);
  ReWrite(DebugFile);
finalization
  CloseFile(DebugFile);
end.