www.pudn.com > yrsCapture.zip > capture2.pas

{******************************************************************************} 
{*                                                                            *} 
{*             Adirondack Software & Graphics Capture Form Unit               *} 
{*          (C) Copyright Adirondack Software & Graphics 1996-1998            *} 
{*                                                                            *} 
{******************************************************************************} 
 
unit capture2; 
 
interface 
 
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; 
 
type 
  TForm2 = class( TForm ) 
    procedure FormCreate( Sender: TObject ); 
    procedure FormMouseDown( Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer ); 
    procedure FormMouseMove( Sender: TObject; Shift: TShiftState; X, 
      Y: Integer ); 
    procedure FormMouseUp( Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer ); 
    procedure FormPaint( Sender: TObject ); 
    procedure FormDestroy( Sender: TObject ); 
  private 
    { Private declarations } 
    fDragging: Boolean; 
 
    procedure WMEraseBkGnd(  Var Msg: TWMEraseBkGnd  ); message WM_ERASEBKGND; 
  public 
    { Public declarations } 
    fRect: TRect; 
    fBmp: TBitmap; 
  end; 
 
var 
  Form2: TForm2; 
 
implementation 
 
Uses Main; 
 
{$R *.DFM} 
{==============================================================================} 
procedure TForm2.FormCreate( Sender: TObject ); 
{==============================================================================} 
var 
  aDC: HDC; 
begin 
  fBMP        := TBitmap.Create; 
  fBMP.Width  := Screen.Width; 
  fBMP.Height := Screen.Height; 
  aDC         := GetDC(  0  ); 
  BitBlt(  fBMP.Canvas.handle, 0, 0, Screen.Width, Screen.Height, 
          aDC, 0, 0, srcCopy  ); 
  ReleaseDC(  0, aDC  ); 
  SetBounds(  0, 0, Screen.Width, Screen.Height  ); 
end; 
 
{==============================================================================} 
procedure TForm2.FormMouseDown( Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer ); 
{==============================================================================} 
begin 
  if mbLeft = Button then begin 
    fDragging := True; 
    SetRect(  fRect, X, Y, X, Y  ); 
    Canvas.DrawFocusrect(  fRect  ); 
  end; 
end; 
 
{==============================================================================} 
procedure TForm2.FormMouseMove( Sender: TObject; Shift: TShiftState; X, 
  Y: Integer ); 
{==============================================================================} 
begin 
  if fDragging then begin 
    Canvas.DrawFocusrect(  fRect  ); 
    fRect.Right  := X; 
    fRect.Bottom := Y; 
    Canvas.DrawFocusrect(  fRect  ); 
  end; 
end; 
 
{==============================================================================} 
procedure TForm2.FormMouseUp( Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer ); 
{==============================================================================} 
begin 
  if fDragging then begin 
    Canvas.DrawFocusrect(  fRect  ); 
    fDragging := False; 
  end; 
  ModalResult := mrOK; 
end; 
 
{==============================================================================} 
procedure TForm2.FormPaint( Sender: TObject ); 
{==============================================================================} 
begin 
  Canvas.Draw(  0, 0, fBMP  ); 
end; 
 
{==============================================================================} 
procedure TForm2.FormDestroy( Sender: TObject ); 
{==============================================================================} 
begin 
  fBMP.Free; 
end; 
 
{==============================================================================} 
Procedure TForm2.WMEraseBkGnd(  var Msg: TWMEraseBkGnd  ); 
{==============================================================================} 
begin 
  Msg.Result := 1; 
end; 
 
end.