canvas教程

Delphi图象截取编程示例(8)

字号+ 作者:H5之家 来源:H5之家 2016-03-05 18:04 我要评论( )

给自己一点时间接受自己,爱自己,趁着下午茶的时间来学习图老师推荐的Delphi图象截取编程示例(8),过去的都会过去,迎接崭新的开始,释放更美好的自己。

 

  
  创建一个新的Form3,保存为Capture3.pas。设置属性BorderIcons的四个属性为false.
  BorderStyle设为bsNone,FormStyle设为fsStayOnTop.
  一个私有变量:fDragging:Boolean; 两个公共变量:fRect:TRect,fBmp:TBitmap;

图老师

  unit Capture3;

图老师

  interface

  uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs;

  type
    TForm3 = 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 FormActivate(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
      procedure FormPaint(Sender: TObject);
    private
      fDragging:Boolean;
    public
      fRect:TRect;
      fBmp:TBitmap;
    end;

  var
    Form3: TForm3;

  implementation

  {$R *.dfm}

  //创建一个新的自定义光标CURSOR_2,放在Capture3.res资源
  //文件中.是32*32的白色矩形边框,用来指示抓图的范围.
  procedure TForm3.FormCreate(Sender: TObject);
  var aDC:HDC ;
  const crBox = -19;
  begin
    Screen.Cursors[crBox]:=LoadCursor(hInstance,'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 TForm3.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 TForm3.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 TForm3.FormMouseUp(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
  begin
    ModalResult:=mrOK;
  end;

  procedure TForm3.FormActivate(Sender: TObject);
  const crHand=-18;
  begin
    Screen.Cursors[crHand]:=LoadCursor(hInstance,pChar('CURSOR_1'));
    Cursor:=crHand;
  end;

  procedure TForm3.FormDestroy(Sender: TObject);
  begin
    fBmp.Free;
    Screen.Cursor := crDefault;
  end;

  procedure TForm3.FormPaint(Sender: TObject);
  begin
    Canvas.Draw(0,0,fBmp);
  end;

  end.

来源:

 

1.本站遵循行业规范,任何转载的稿件都会明确标注作者和来源;2.本站的原创文章,请转载时务必注明文章作者和来源,不尊重原创的行为我们将追究责任;3.作者投稿可能会经我们编辑修改或补充。

相关文章
  • 03. Canvas简介,Canvas的使用方法

    03. Canvas简介,Canvas的使用方法

    2015-09-29 18:00

网友点评