uecran.~pas

来自「this application can Paint_Into_Desktop」· ~PAS 代码 · 共 81 行

unit Uecran;

interface

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

type
  TEcran = class(TForm)
    ButtonLigne: TButton;
    ButtonCopie: TButton;
    ButtonZoom: TButton;
    Timer1: TTimer;
    Panel1: TPanel;
    Im: TImage;
    TB: TTrackBar;
    procedure ButtonLigneClick(Sender: TObject);
    procedure ButtonCopieClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ButtonZoomClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { D閏larations priv閑s }
    c : Tcanvas;
    d : integer;
  public
    { D閏larations publiques }
  end;

var
  Ecran: TEcran;

implementation

{$R *.DFM}

procedure TEcran.ButtonLigneClick(Sender: TObject);
begin
  c.pen.width := 8;
  c.pen.color := clred;
  c.lineto (200,200);
end;

procedure TEcran.ButtonCopieClick(Sender: TObject);
var myrect: TRect;
begin
  myrect := rect (0,0,im.width, im.height);    // copie d'une portion de l'閏ran
  im.canvas.copyrect (myrect, c, myrect);
end;

procedure TEcran.FormActivate(Sender: TObject);
begin
  c := TCanvas.create;
  c.Handle := getDC(0);  // r閟up閞ation du canvas de l'閏ran
end;

procedure TEcran.Timer1Timer(Sender: TObject);
var pt : Tpoint;
begin
  GetCursorPos (pt);     // position de la souris
  im.Canvas.copyrect (rect(0,0,im.width, im.height), c, rect(pt.x-tb.position, pt.y-tb.position, pt.x+tb.position, pt.y+tb.position));
end;

procedure TEcran.ButtonZoomClick(Sender: TObject);
begin
  timer1.enabled := not timer1.enabled;
  if ButtonZoom.caption = 'Zoom' then
    ButtonZoom.caption := 'No Zoom'
  else
    ButtonZoom.caption := 'Zoom';
end;

procedure TEcran.FormDestroy(Sender: TObject);
begin
  c.free;
end;

end.