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

📄 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 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;
    Window1: TMenuItem;
    Help1: TMenuItem;
    N1: TMenuItem;
    FileExitItem: TMenuItem;
    WindowCascadeItem: TMenuItem;
    WindowTileItem: TMenuItem;
    WindowArrangeItem: 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;
    WindowCascade1: TWindowCascade;
    WindowTileHorizontal1: TWindowTileHorizontal;
    WindowArrangeAll1: TWindowArrange;
    WindowMinimizeAll1: TWindowMinimizeAll;
    HelpAbout1: TAction;
    FileClose1: TWindowClose;
    WindowTileVertical1: TWindowTileVertical;
    ToolBar2: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton8: TToolButton;
    ToolButton10: 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;
    ToolButton20: TToolButton;
    ASGScreenCapture1: TASGScreenCapture;
    SavePictureDialog1: TSavePictureDialog;
    ToolButton4: TToolButton;
    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 FileClose1Execute(Sender: TObject);
    procedure WindowTileHorizontal1Execute(Sender: TObject);
    procedure WindowArrangeAll1Execute(Sender: TObject);
    procedure WindowCascade1Execute(Sender: TObject);
    procedure FileSaveAs1Execute(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure WindowTileVertical1Execute(Sender: TObject);
  private
    { Private declarations }
    procedure CreateMDIChild(const Name: string);
    procedure Updatetools;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

uses ShellAPI, ChildWin, About;

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

procedure TMainForm.CreateMDIChild(const Name: string);
begin
  { create a new MDI child window }
  Child := TMDIChild.Create(Application);
  Child.Caption := Name;
  if FileExists(Name) then Child.Image.Picture.LoadFromFile(Name);
end;

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

procedure TMainForm.FileOpen1Execute(Sender: TObject);
begin
  if OpenPictureDialog.Execute then
    CreateMDIChild(OpenPictureDialog.FileName);
  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);
var
  W: TMDIChild;
begin
  CreateMDIChild('Captured Desktop');
  W := ActiveMDIChild as TMDIChild;
  W.Image.Picture.Assign(ASGScreenCapture1.CaptureDesktop);
  with W.ScrollBox do
  begin
    HorzScrollBar.Range := W.Image.Picture.Width;
    VertScrollBar.Range := W.Image.Picture.Height;
  end;
  W.Image.Refresh;
  UpdateTools;
end;

procedure TMainForm.CaptureActive1Execute(Sender: TObject);
var
  W: TMDIChild;
begin
  CreateMDIChild('Captured Active Window');
  W := ActiveMDIChild as TMDIChild;
  W.Image.Picture.Assign(ASGScreenCapture1.CaptureActiveWindow);
  with W.ScrollBox do
  begin
    HorzScrollBar.Range := W.Image.Picture.Width;
    VertScrollBar.Range := W.Image.Picture.Height;
  end;
  W.Image.Refresh;
  UpdateTools;
end;

procedure TMainForm.CaptureObject1Execute(Sender: TObject);
var
  W: TMDIChild;
begin
  CreateMDIChild('Captured Object');
  W := ActiveMDIChild as TMDIChild;
  W.Image.Picture.Assign(ASGScreenCapture1.CaptureObject);
  with W.ScrollBox do
  begin
    HorzScrollBar.Range := W.Image.Picture.Width;
    VertScrollBar.Range := W.Image.Picture.Height;
  end;
  W.Image.Refresh;
  UpdateTools;
end;

procedure TMainForm.CaptureArea1Execute(Sender: TObject);
var
  W: TMDIChild;
begin
  CreateMDIChild('Captured Rect');
  W := ActiveMDIChild as TMDIChild;
  W.Image.Picture.Assign(ASGScreenCapture1.CaptureSelection);
  with W.ScrollBox do
  begin
    HorzScrollBar.Range := W.Image.Picture.Width;
    VertScrollBar.Range := W.Image.Picture.Height;
  end;
  W.Image.Refresh;
  UpdateTools;
end;

procedure TMainForm.FileClose1Execute(Sender: TObject);
var
  W: TMDIChild;
begin
  W := ActiveMDIChild as TMDIChild;
  W.Close;
  UpdateTools;
end;

procedure TMainForm.WindowTileHorizontal1Execute(Sender: TObject);
begin
  TileMode := tbHorizontal;
  Tile;
end;

procedure TMainForm.WindowTileVertical1Execute(Sender: TObject);
begin
  TileMode := tbVertical;
  Tile;
end;

procedure TMainForm.WindowArrangeAll1Execute(Sender: TObject);
begin
  ArrangeIcons;
end;

procedure TMainForm.WindowCascade1Execute(Sender: TObject);
begin
  Cascade;
end;

procedure TMainForm.FileSaveAs1Execute(Sender: TObject);
var
  W: TMDIChild;
begin
  if SavePictureDialog1.Execute then
  begin
    W := ActiveMDIChild as TMDIChild;
    W.Image.Picture.SaveToFile(SavePictureDialog1.Filename);
  end;
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 + -