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

{******************************************************************************} 
{*                                                                            *} 
{*             Adirondack Software & Graphics Capture Icon Unit               *} 
{*         (C) Copyright Adirondack Software & Graphics 1996-1998             *} 
{*                                                                            *} 
{******************************************************************************} 
 
unit capture4; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; 
 
type 
  TForm4 = class( TForm ) 
    procedure FormCreate( Sender: TObject ); 
    procedure FormMouseUp( Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer ); 
    procedure FormPaint( Sender: TObject ); 
    procedure FormDestroy( Sender: TObject ); 
    procedure FormMouseDown( Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer ); 
    procedure FormMouseMove( Sender: TObject; Shift: TShiftState; X, 
      Y: Integer ); 
    procedure FormActivate( Sender: TObject ); 
  private 
    { Private declarations } 
    fDragging: Boolean; 
    procedure WMEraseBkGnd(  Var Msg: TWMEraseBkGnd  ); message WM_ERASEBKGND; 
  public 
    { Public declarations } 
    fRect: TRect; 
    fBmp: TBitmap; 
  end; 
 
var 
  Form4: TForm4; 
 
implementation 
 
Uses Main; 
 
{$R *.DFM} 
{$R Capture4.Res} 
 
{==============================================================================} 
procedure TForm4.FormCreate( Sender: TObject ); 
{==============================================================================} 
var 
  aDC: HDC; 
const 
  crBox = -19; 
begin 
  Screen.Cursors[crBox] := LoadCursor( hInstance, pChar( 'CURSOR_2' ) ); 
  Cursor := crBox; 
  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 TForm4.FormMouseUp( Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer ); 
{==============================================================================} 
begin 
  ModalResult := mrOK; 
end; 
 
{==============================================================================} 
procedure TForm4.FormPaint( Sender: TObject ); 
{==============================================================================} 
begin 
  Canvas.Draw(  0, 0, fBMP  ); 
end; 
 
{==============================================================================} 
procedure TForm4.FormDestroy( Sender: TObject ); 
{==============================================================================} 
begin 
  fBMP.Free; 
  Screen.Cursor := crDefault; 
end; 
 
{==============================================================================} 
procedure TForm4.WMEraseBkGnd(  var Msg: TWMEraseBkGnd  ); 
{==============================================================================} 
begin 
  Msg.Result := 1; 
end; 
 
{==============================================================================} 
procedure TForm4.FormMouseDown( Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer ); 
{==============================================================================} 
begin 
if mbLeft = Button then begin 
    fDragging := True; 
    SetRect(  fRect, X, Y, X+32, Y+32  ); 
    //Canvas.DrawFocusRect(  fRect  ); 
  end; 
end; 
 
{==============================================================================} 
procedure TForm4.FormMouseMove( Sender: TObject; Shift: TShiftState; X, 
  Y: Integer ); 
{==============================================================================} 
begin 
 if fDragging then begin 
    //Canvas.DrawFocusRect(  fRect  ); 
    fRect.Left   := X; 
    fRect.Top    := Y; 
    fRect.Right  := X+32; 
    fRect.Bottom := Y+32; 
    //Canvas.DrawFocusrect(  fRect  ); 
  end; 
end; 
 
{==============================================================================} 
procedure TForm4.FormActivate( Sender: TObject ); 
{==============================================================================} 
const 
  crBox = -19; 
begin 
   Screen.Cursors[crBox] := LoadCursor( hInstance, pChar( 'CURSOR_2' ) ); 
   Cursor := crBox; 
end; 
 
end.