unit2.pas

来自「精彩编程百例51～75 其中有 cpu速度测试 检测声卡 查询内存信息 图像处理」· PAS 代码 · 共 146 行

unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  foldx,foldy,oldx,oldy,x1,x2,y1,y2:integer;
  flag,trace:boolean;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm2.Timer1Timer(Sender: TObject);
var
 Fullscreen:Tbitmap;
 FullscreenCanvas:TCanvas;
 dc:HDC;
begin
  timer1.Enabled:=false;
  Fullscreen := TBitmap.Create;
  Fullscreen.Width := screen.width;
  Fullscreen.Height := screen.Height;
  DC := GetDC (0);
  FullscreenCanvas := TCanvas.Create;
  FullscreenCanvas.Handle := DC;
  Fullscreen.Canvas.CopyRect (Rect(0, 0, screen.Width, screen.Height), fullscreenCanvas,Rect (0, 0, Screen.Width, Screen.Height));
  FullscreenCanvas.Free;
  ReleaseDC (0, DC);
  image1.picture.Bitmap:=fullscreen;
  image1.Width:=fullscreen.Width;
  image1.Height:=fullscreen.Height;
  fullscreen.free;
  form2.WindowState:=wsMaximized;
  form2.show;
  messagebeep(1);
  foldx:=-1;
  foldy:=-1;
  image1.Canvas.Pen.mode:=pmnot; //笔的模式为取反
  image1.canvas.pen.color:=clblack; //笔为黑色
  image1.canvas.brush.Style:=bsclear; //空白刷子
  flag:=true;
end;

procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  width,height:integer;
  newbitmap:Tbitmap;
begin
  if (trace=false) then  // TRACE表示是否在追踪鼠标
  begin      //首次点击鼠标左键，开始追踪鼠标。
    flag:=false;
    with image1.canvas do
      begin
        moveTo(foldx,0);
        LineTo(foldx,screen.height);
        moveto(0,foldy);
        lineto(screen.width,foldy);
      end;
    x1:=x;
    y1:=y;
    oldx:=x;
    oldy:=y;
    trace:=true;
    image1.Canvas.Pen.mode:=pmnot;     //笔的模式为取反
        //这样再在原处画一遍矩形，相当于擦除矩形。
    image1.canvas.pen.color:=clblack;  //笔为黑色
    image1.canvas.brush.Style:=bsclear;//空白刷子
  end
  else
  begin       //第二次点击，表示已经得到矩形了，把它拷贝到FORM1中的IMAGE部件上。
    x2:=x;
    y2:=y;
    trace:=false;
    image1.canvas.rectangle(x1,y1,oldx,oldy);
    width:=abs(x2-x1);
    height:=abs(y2-y1);
    form1.image1.Width:=Width;
    form1.image1.Height:=Height;
    newbitmap:=Tbitmap.create;
    newbitmap.width:=width;
    newbitmap.height:=height;
    newbitmap.Canvas.CopyRect(Rect (0, 0, width, Height),form2.image1.canvas,Rect (x1, y1,x2,y2)); //拷贝
    form1.image1.picture.bitmap:=newbitmap; //放到FORM的IMAGE上
    newbitmap.free;    
    form2.hide;
    form1.show;
  end;
end;

procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if trace=true then   //是否在追踪鼠标
    begin             //是，擦除旧的矩形并画上新的矩形
      with image1.canvas do
      begin
        rectangle(x1,y1,oldx,oldy);
        Rectangle(x1,y1,x,y);
        oldx:=x;
        oldy:=y;
      end;
    end
  else if flag=true then  //在鼠标所在的位置上画十字
    begin
      with image1.canvas do
        begin
        moveTo(foldx,0);          //擦除旧的十字
        LineTo(foldx,screen.height);
        moveto(0,foldy);
        lineto(screen.width,foldy);
        moveTo(x,0);              //画上新的十字
        LineTo(x,screen.height);
        moveto(0,y);
        lineto(screen.width,y);
        foldx:=x;
        foldy:=y;
        end;
    end;
end;

end.