unit2.pas

Delphi编程实效百例的随书程序 这是其中的界面操作部分

unit Unit2;

interface

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

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

var
  Form2: TForm2;
  foldx,x1,y1,x2,y2,oldx,oldy,foldy: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.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;

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;

end.