unit2.pas

由DELPHI制作的可以直接抓取屏幕,并在上面写字绘图的一个软件,请指正.

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, Buttons, ColorGrd, Spin;
const
  mousemsg=wm_user+1;
  iid=100;

type
  TForm2 = class(TForm)
    Image1: TImage;
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    Panel2: TPanel;
    Edit1: TEdit;
    ListBox1: TListBox;
    Memo1: TMemo;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    SpinEdit1: TSpinEdit;
    Label2: TLabel;
    ColorGrid1: TColorGrid;
    GroupBox2: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    Edit2: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BitBtn1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure ColorGrid1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
    Fullscreen:Tbitmap;
    IsHua:Boolean;
    x1,y1:integer;
    cdir:string;
implementation

{$R *.dfm}
procedure bmpcut;
var

  FullscreenCanvas:TCanvas;
  dc:HDC;
begin
Fullscreen := TBitmap.Create;  //创建一个BITMAP来存放图象
  Fullscreen.Width := screen.width;
  Fullscreen.Height := screen.Height;
  DC := GetDC (0);   //取得屏幕的 DC，参数0指的是屏幕
  FullscreenCanvas := TCanvas.Create; //创建一个CANVAS对象
  FullscreenCanvas.Handle := DC;
  Fullscreen.Canvas.CopyRect
  (Rect (0, 0, screen.Width, screen.Height), fullscreenCanvas,
  Rect (0, 0, Screen.Width, Screen.Height));//把整个屏幕复制到BITMAP中
  FullscreenCanvas.Free;     //释放CANVAS对象
  ReleaseDC (0, DC);         //释放DC

end;
procedure TForm2.FormCreate(Sender: TObject);
var
  i:integer;
begin
 bmpcut;
   image1.picture.Bitmap:=fullscreen;//拷贝下的图象赋给IMAGE对象
  image1.Width:=fullscreen.Width;
  image1.Height:=fullscreen.Height;
  fullscreen.free;
  IsHua:=false;
  image1.Canvas.Font.Size:=12;
  image1.Canvas.Font.color:=clred;
  setlength(cdir,144);
  if getcurrentdirectory(144,pchar(cdir))<>0 then
  begin
    setlength(cdir,strlen(pchar(cdir)));
    cdir:=cdir+'\SHULUWENZI.txt';
    Memo1.Lines.LoadFromFile(cdir);
  end;
  for i:=0 to memo1.Lines.count-1 do
    listbox1.Items.Add(memo1.Lines.Strings[i]);
end;

procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 panel1.Visible :=false;
 panel2.Visible :=false;
 if Button=mbLeft then
 begin

  IsHua:=true;
  image1.Canvas.pen.Color:=edit2.Color  ;
  image1.Canvas.Pen.Width :=spinedit1.Value  ;
  image1.Canvas.moveTo(x,y);
 end else
 if Button=mbRight then
 begin
   panel1.Top:=y;
   panel1.Left:=x;
   panel1.Visible:=true;
  end;
 if button=mbMiddle then
 begin
   panel2.Top:=y+30;
   panel2.Left:=x;
   panel2.Visible:=true;
   x1:=x;
   y1:=y;

 end;
end;

procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
  if ishua then
  image1.Canvas.LineTo(x,y);
end;

procedure TForm2.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  IsHua:=false;
end;

procedure TForm2.BitBtn1Click(Sender: TObject);
begin
panel1.Visible:=false;
end;

procedure TForm2.ListBox1Click(Sender: TObject);
begin
image1.Canvas.Font.Color:=edit2.Color ;
image1.Canvas.Font.Size:=spinedit1.Value +12 ;
image1.Canvas.TextOut(X1, Y1, listbox1.Items[listbox1.itemindex]);
end;

procedure TForm2.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
  if edit1.Text <> '' then
  begin
 listbox1.Items.Add(edit1.text);
image1.Canvas.Font.Color:=edit2.Color ;
image1.Canvas.Font.Size:=spinedit1.Value +12 ;
image1.Canvas.TextOut(X1, Y1, edit1.text);
edit1.Text:='';
end;
end;

procedure TForm2.ColorGrid1Click(Sender: TObject);
begin
  edit2.Color:=colorgrid1.ForegroundColor;
end;

end.