⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 Apprehend Screen Capture Component Version 4.2 A non-visible component to capture images. Freeware w
💻 PAS
字号:
{----------------------------------------------------------------------------
| Library: ASG Screen Capture ( Apprehend 2001 ) TImage SDI Demo
| Adirondack Software & Graphics Capture Main Form Unit for Delphi 5
| (C) Copyright Adirondack Software & Graphics 1996-2001
|
| Module: ASGCapture
|
| Description: TASGScreenCapture class and non-visible component.
|
| Known Problems: None
|---------------------------------------------------------------------------}

unit Main;

interface

uses Windows, SysUtils, GraphicEX, Classes, Graphics, Forms, Controls,
  Menus, StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls,
  StdActns, ActnList, ToolWin, ImgList, ExtDlgs, ASGCapture;

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    FileOpenItem: TMenuItem;
    FileCloseItem: TMenuItem;
    Help1: TMenuItem;
    N1: TMenuItem;
    FileExitItem: TMenuItem;
    HelpAboutItem: TMenuItem;
    FileSaveItem: TMenuItem;
    FileSaveAsItem: TMenuItem;
    StatusBar: TStatusBar;
    ActionList1: TActionList;
    EditCut1: TEditCut;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    FileNew1: TAction;
    FileSave1: TAction;
    FileExit1: TAction;
    FileOpen1: TAction;
    FileSaveAs1: TAction;
    HelpAbout1: TAction;
    FileClose1: TWindowClose;
    ToolBar2: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ImageList1: TImageList;
    Capture1: TMenuItem;
    Desktop1: TMenuItem;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    ToolButton18: TToolButton;
    ToolButton19: TToolButton;
    CaptureDesktop1: TAction;
    CaptureArea1: TAction;
    CaptureActive1: TAction;
    CaptureObject1: TAction;
    Area1: TMenuItem;
    ActiveWindow1: TMenuItem;
    Object1: TMenuItem;
    OpenPictureDialog: TOpenPictureDialog;
    ASGScreenCapture1: TASGScreenCapture;
    SavePictureDialog1: TSavePictureDialog;
    ScrollBox: TScrollBox;
    Image: TImage;
    procedure FileOpen1Execute(Sender: TObject);
    procedure HelpAbout1Execute(Sender: TObject);
    procedure FileExit1Execute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CaptureDesktop1Execute(Sender: TObject);
    procedure CaptureActive1Execute(Sender: TObject);
    procedure CaptureObject1Execute(Sender: TObject);
    procedure CaptureArea1Execute(Sender: TObject);
    procedure FileSaveAs1Execute(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    procedure Updatetools;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

uses ShellAPI;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  OpenPictureDialog.DefaultExt := GraphicExtension(TBitmap);
  OpenPictureDialog.Filter := GraphicFilter(TBitmap);
  UpdateTools;
end;

procedure TMainForm.UpdateTools;
begin
  FileNew1.Enabled := True;
  FileOpen1.Enabled := True;
  FileClose1.Enabled := MDIChildCount <> 0;
  FileSave1.Enabled := MDIChildCount <> 0;
  FileSaveAs1.Enabled := MDIChildCount <> 0;
end;

procedure TMainForm.FileOpen1Execute(Sender: TObject);
begin
  if OpenPictureDialog.Execute then begin
    if FileExists(OpenPictureDialog.FileName) then Image.Picture.LoadFromFile(OpenPictureDialog.FileName);
    with ScrollBox do
      begin
        HorzScrollBar.Range := Image.Picture.Width;
        VertScrollBar.Range := Image.Picture.Height;
      end;
    end;
  UpdateTools;
end;

procedure TMainForm.HelpAbout1Execute(Sender: TObject);
begin
  ShellAbout(Application.Handle, 'Apprehend 2001 Screen Capture',
    'More info at: http://www.software.adirondack.ny.us', Application.Icon.Handle);
end;

procedure TMainForm.FileExit1Execute(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.CaptureDesktop1Execute(Sender: TObject);
begin
  Image.Picture.Assign(ASGScreenCapture1.CaptureDesktop);
  with ScrollBox do
  begin
    HorzScrollBar.Range := Image.Picture.Width;
    VertScrollBar.Range := Image.Picture.Height;
  end;
  Image.Refresh;
  UpdateTools;
end;

procedure TMainForm.CaptureActive1Execute(Sender: TObject);
begin
  Image.Picture.Assign(ASGScreenCapture1.CaptureActiveWindow);
  with ScrollBox do
  begin
    HorzScrollBar.Range := Image.Picture.Width;
    VertScrollBar.Range := Image.Picture.Height;
  end;
  Image.Refresh;
  UpdateTools;
end;

procedure TMainForm.CaptureObject1Execute(Sender: TObject);
begin
  Image.Picture.Assign(ASGScreenCapture1.CaptureObject);
  with ScrollBox do
  begin
    HorzScrollBar.Range := Image.Picture.Width;
    VertScrollBar.Range := Image.Picture.Height;
  end;
  Image.Refresh;
  UpdateTools;
end;

procedure TMainForm.CaptureArea1Execute(Sender: TObject);
begin
  Image.Picture.Assign(ASGScreenCapture1.CaptureSelection);
  with ScrollBox do
  begin
    HorzScrollBar.Range := Image.Picture.Width;
    VertScrollBar.Range := Image.Picture.Height;
  end;
  Image.Refresh;
  UpdateTools;
end;

procedure TMainForm.FileSaveAs1Execute(Sender: TObject);
begin
  if SavePictureDialog1.Execute then
    Image.Picture.SaveToFile(SavePictureDialog1.Filename);
end;

procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  UpdateTools;
end;

end.

⌨️ 快捷键说明

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