createcompatibledcu.pas

Delphi Win32核心API参考光盘源码 本书包含了常用的Windows API函数

unit CreateCompatibleDCU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  OffscreenDC: HDC;        // an offscreen device context
  ANDMaskBitmap,           // used for holding the different parts of the
  ORMaskBitmap,            // circle graphic
  BackgroundBitmap,
  OldBitmap: HBITMAP;
  BallXCoord: Integer;     // the current horizontal coordinates of the circle

implementation

{$R *.DFM}

procedure TForm1.Timer1Timer(Sender: TObject);
var
  ScreenDC,               // a handle to the screen device context
  WorkDC: HDC;            // a handle to a temporary device context
  OldBitmap: HBITMAP;     // holds the previous bitmap
begin
  {retrieve a handle to the device context for the screen}
  ScreenDC := GetDC(0);

  {create a memory device context}
  WorkDC := CreateCompatibleDC(Canvas.Handle);

  {restore the previous background to the screen}
  BitBlt(ScreenDC, BallXCoord, Form1.Top, 40, 40, OffscreenDC, 0, 0, SRCCOPY);

  {increment the horizontal coordinate of the circle}
  Inc(BallXCoord);

  {wrap the circle around the screen if it has gone beyond the edges}
  if BallXCoord>GetSystemMetrics(SM_CXSCREEN) then
    BallXCoord := -40;

  {save the background at the current location of the circle}
  BitBlt(OffscreenDC, 0, 0, 40, 40, ScreenDC, BallXCoord, Form1.Top, SRCCOPY);

  {select the AND mask of the circle into the memory device context, and
   copy it to the screen}
  OldBitmap := SelectObject(WorkDC, ANDMaskBitmap);
  BitBlt(ScreenDC, BallXCoord, Form1.Top, 40, 40, WorkDC, 0, 0, SRCAND);

  {select the OR mask of the circle into the memory device context, and
   copy it to the screen}
  SelectObject(WorkDC, ORMaskBitmap);
  BitBlt(ScreenDC, BallXCoord, Form1.Top, 40, 40, WorkDC, 0, 0, SRCPAINT);

  {select the old bitmap back into the memory device context, and delete or
   release all unneeded objects}
  SelectObject(WorkDC, OldBitmap);
  ReleaseDC(0, ScreenDC);
  DeleteDC(WorkDC);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  TempBrush: HBRUSH;     // a handle to a brush
begin
  {create a memory device context}
  OffscreenDC   := CreateCompatibleDC(Canvas.Handle);

  {a lot of attributes of the device context will change, so save its original
   state so we don't have to reselect the original objects back into the
   device context}
  SaveDC(OffscreenDC);

  {create the bitmap for the circle's AND mask}
  AndMaskBitmap := CreateCompatibleBitmap(Canvas.Handle, 40, 40);

  {select the bitmap into the memory device context and draw a black circle
   on a white background}
  SelectObject(OffscreenDC, AndMaskBitmap);
  SelectObject(OffscreenDC, GetStockObject(WHITE_BRUSH));
  SelectObject(OffscreenDC, GetStockObject(NULL_PEN));
  Rectangle(OffscreenDC, 0, 0, 41, 41);
  SelectObject(OffscreenDC, GetStockObject(BLACK_BRUSH));
  Ellipse(OffscreenDC, 0, 0, 40, 40);

  {create the bitmap for the circle's OR mask}
  ORMaskBitmap := CreateCompatibleBitmap(Canvas.Handle, 40, 40);

  {select the bitmap into the memory device context and draw a hatched circle
   on a black background}
  SelectObject(OffscreenDC, ORMaskBitmap);
  SelectObject(OffscreenDC, GetStockObject(BLACK_BRUSH));
  Rectangle(OffscreenDC, 0, 0, 41, 41);
  TempBrush := CreateHatchBrush(HS_DIAGCROSS, clRed);
  SelectObject(OffscreenDC, GetStockObject(BLACK_PEN));
  SelectObject(OffscreenDC, TempBrush);
  Ellipse(OffscreenDC, 0, 0, 40, 40);

  {restore the device context's original settings. this eliminates the need to
   reselect all of the original objects back into the device context when we
   are through}
  RestoreDC(OffscreenDC, -1);

  {delete the brush}
  DeleteObject(TempBrush);

  {finally create a bitmap to hold the background of the screen. this keeps
   the animated circle from leaving a trail behind it}
  BackgroundBitmap := CreateCompatibleBitmap(Canvas.Handle, 40, 40);

  {select the background bitmap into the memory device context}
  SelectObject(OffscreenDC, BackgroundBitmap);

  {initialize the coordinates of the circle so it will begin off screen
   to the left}
  BallXCoord := -40;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  {delete all unneeded bitmaps and device contexts}
  SelectObject(OffscreenDC, OldBitmap);
  DeleteObject(BackgroundBitmap);
  DeleteObject(ANDMaskBitmap);
  DeleteObject(ORMaskBitmap);
  DeleteDC(OffscreenDC);
end;

end.