程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> Delphi圖象截取編程示例(8)

Delphi圖象截取編程示例(8)

編輯:Delphi

  (七)抓取圖標(ICON)的窗體
  創建一個新的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. 下一頁:
Copyright © 程式師世界 All Rights Reserved