📄 main.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 + -