DirectX的使用

//////////////////////////////////////  

// Purpose:  

// Project: DirectDraw1.dpr  

// Copyright (c) 1998 by Charlie Calvert  

//  

unit Main;  

interface  

uses  

 Windows, Messages, SysUtils,  

 Classes, Graphics, Controls,  

 Forms, Dialogs, ExtCtrls,  

 DirectX;// 该单元是《DELPHI编程技术内幕》的书自带的一个单元  

         //如果需要，可以扒出来  

type  

 TForm1 = class(TForm)  

   Timer1: TTimer;  

   procedure FormCreate(Sender: TObject);  

   procedure FormDestroy(Sender: TObject);  

   procedure FormKeyDown(Sender: TObject; var Key: Word;  

     Shift: TShiftState);  

   procedure FormPaint(Sender: TObject);  

   procedure Timer1Timer(Sender: TObject);  

 private  

   FDirectDraw: IDirectDraw;            // DirectDraw object  

   FPrimarySurface: IDirectDrawSurface; // DirectDraw primary surface  

   FBackSurface: IDirectDrawSurface;    // DirectDraw back surface  

   FActive: Boolean;                    // is application active?  

   FPhase: Byte;  

   FFrontMsg: string;  

   FBackMsg: string;  

   procedure Start;  

   { Private declarations }  

 public  

   { Public declarations }  

 end;  

const  

 AFileName = 'c:\debug.txt';  

   

var  

 Form1: TForm1;  

 DebugFile: TextFile;  

implementation  

{$R *.DFM}  

procedure TForm1.FormCreate(Sender: TObject);  

begin  

 Width := 640;  

 Height := 480;  

 FDirectDraw := nil;  

 FPhase := 0;  

 FActive := False;  

 FFrontMsg := 'Front buffer (F12 or Esc to quit)';  

 FBackMsg := 'Back buffer (F12 or Esc to quit)';  

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.Start;  

var  

 hr: HRESULT;  

 SurfaceDesc: TDDSURFACEDESC ;  

 DDSCaps: TDDSCAPS;  

 DC: HDC;  

begin  

 hr := DirectDrawCreate(nil, FDirectDraw, nil);  

 //初始化dircetdraw  

 if(hr = DD_OK) then begin  

   // Get exclusive mode  

   hr := FDirectDraw.SetCooperativeLevel(Handle, // DDSCL_NORMAL);  

     DDSCL_EXCLUSIVE or DDSCL_FULLSCREEN);//进入独占模式  

   if(hr = DD_OK) then begin  

     hr := FDirectDraw.SetDisplayMode(640, 480, 8);//设置分辨率640*480 256色

     if(hr = DD_OK) then begin  

       // Create the primary surface with 1 back buffer  

       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  

         // Get a pointer to the back buffer  

         ddscaps.dwCaps := DDSCAPS_BACKBUFFER;  

         hr := FPrimarySurface.GetAttachedSurface(ddscaps,  

                                               FBackSurface);  

         if(hr = DD_OK) then begin  

           // draw some text.  

           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 (FBackSurface.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));  

               FBackSurface.ReleaseDC(DC);  

           end;  

           // Create a timer to flip the pages  

            FActive := True;  

           Timer1.Enabled := True;  

           Exit;  

         end;  

       end;  

     end;  

   end;  

 end;  

 MessageBox(Handle, PChar(Format('Direct Draw Init Failed %x', [hr])),  

   'ERROR', MB_OK);  

 Close();  

end;  

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;  

 Shift: TShiftState);  

begin  

  case Key of  

    VK_F3: Start();  

    VK_ESCAPE, VK_F12: begin  

      Timer1.Enabled := False;  

      Close;  

    end;  

  end;  

end;  

procedure TForm1.FormPaint(Sender: TObject);  

const  

 Msg = 'Page Flipping Test: Press F3 to start, 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)-1);  

   ReleaseDC(Handle, DC);  

 end;  

end;  

procedure TForm1.Timer1Timer(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  

     hr := FPrimarySurface.Restore();  

     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.