unit1.pas

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

PAS
103
字号
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Timer1: TTimer;
    SavePictureDialog1: TSavePictureDialog;
    procedure BitBtn4Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Fullscreen:Tbitmap;
  FullscreenCanvas:TCanvas;
  dc:HDC;
begin
  timer1.Enabled:=false;   //取消时钟
  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
  image1.picture.Bitmap:=fullscreen;//拷贝下的图象赋给IMAGE对象
  image1.Width:=fullscreen.Width;
  image1.Height:=fullscreen.Height;
  fullscreen.free;                //释放bitmap
  form1.WindowState:=wsNormal;    //复原窗口状态
  form1.show;                     //显示窗口
  messagebeep(1);  //BEEP叫一声,报告图象已经截取好了。
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  form1.WindowState:=wsMinimized; //最小化程序窗口
  form1.hide;                     //把程序藏起来
  timer1.enabled:=true;           //打开记时器
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  if savePicturedialog1.Execute then
    begin
      form1.Image1.Picture.SaveToFile(savepicturedialog1.filename)//保存图像文件
    end;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  form1.hide;
  form2.hide;//隐藏form1,form2
  form2.Timer1.Enabled:=true;//计时器开始工作
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  form1.SavePictureDialog1.title:='保存所抓图像文件';//保存对话框标题
  form1.SavePictureDialog1.InitialDir:='C:\My Documents\My Pictures';//设置初始保存路径
end;

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?