frmmain.pas

Apprehend Screen Capture Component Version 4.2 A non-visible component to capture images. Freeware w

{----------------------------------------------------------------------------
| Library: ASG Screen Capture ( Apprehend 2000 ) 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
|
| History: July 4, 2000. William Miller, first BETA version
|          July 13, 2000. William Miller, 2nd BETA version
|          Changed CaptureRect.Pas to paint the rubberband
|          on the form instead of a TImage to eliminate screen flicker.
|          July 15, 2000. William Miller, 3nd BETA version
|          Eliminated non-animated rubberbanding added version property
|          July 23, 2000 Final Changes to demo apps.
|---------------------------------------------------------------------------}

unit FrmMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ASGCapture, ImgList, StdActns, ActnList, Menus,  ExtDlgs,
  ExtCtrls, ToolWin, G32_Image, G32_Layers, G32, G32_Filters, G32_Transforms,
  StdCtrls, G32_RangeBars;

type
  TFormMain = class(TForm)
    ToolBar2: TToolBar;
    ToolButton9: TToolButton;
    ToolButton1: TToolButton;
    ToolButton4: TToolButton;
    ToolButton12: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton13: TToolButton;
    ToolButton21: TToolButton;
    ToolButton7: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton18: TToolButton;
    ToolButton17: TToolButton;
    ToolButton19: TToolButton;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    FileNewItem: TMenuItem;
    FileOpenItem: TMenuItem;
    FileCloseItem: TMenuItem;
    FileCloseAll2: TMenuItem;
    FileSaveItem: TMenuItem;
    FileSaveAsItem: TMenuItem;
    N1: TMenuItem;
    FileExitItem: TMenuItem;
    Edit1: TMenuItem;
    CopyItem: TMenuItem;
    PasteItem: TMenuItem;
    Crop1: TMenuItem;
    Undo1: TMenuItem;
    Capture1: TMenuItem;
    Desktop1: TMenuItem;
    Area1: TMenuItem;
    ActiveWindow1: TMenuItem;
    Object1: TMenuItem;
    Miminized1: TMenuItem;
    Minimize1: TMenuItem;
    Automatic1: TMenuItem;
    Delay1: TMenuItem;
    Help1: TMenuItem;
    HelpAboutItem: TMenuItem;
    HelpContents2: TMenuItem;
    ActionList1: TActionList;
    FileNew1: TAction;
    FileOpen1: TAction;
    FileClose1: TWindowClose;
    FileCloseAll1: TAction;
    FileSave1: TAction;
    FileSaveAs1: TAction;
    FileExit1: TAction;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    HelpAbout1: TAction;
    CaptureDesktop1: TAction;
    CaptureArea1: TAction;
    CaptureActive1: TAction;
    CaptureObject1: TAction;
    OptionsMinimize1: TAction;
    OptionsAutomatic1: TAction;
    HelpContents1: TAction;
    OptionsDelay1: TAction;
    EditCrop1: TAction;
    EditUndo1: TAction;
    ImageList1: TImageList;
    ASGScreenCapture1: TASGScreenCapture;
    ToolButton22: TToolButton;
    StatusBar1: TStatusBar;
    PageControl1: TPageControl;
    CaptureImageList: TImageList;
    ProgressBar1: TProgressBar;
    ViewCenter1: TAction;
    View1: TMenuItem;
    Center1: TMenuItem;
    Stretch1: TMenuItem;
    ViewStretch1: TAction;
    ViewNormal1: TAction;
    Normal1: TMenuItem;
    Resize1: TMenuItem;
    Scale1: TMenuItem;
    ViewResize1: TAction;
    ViewScale1: TAction;
    N2: TMenuItem;
    Panel1: TPanel;
    PnlMagn: TPanel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Panel4: TPanel;
    MagnOpacity: TGaugeBar;
    MagnMagnification: TGaugeBar;
    MagnRotation: TGaugeBar;
    MagnInterpolate: TCheckBox;
    pnlBitmapLayer: TPanel;
    Label2: TLabel;
    Panel3: TPanel;
    LayerOpacity: TGaugeBar;
    LayerInterpolate: TCheckBox;
    LayerRescale: TButton;
    LayerResetScale: TButton;
    Cropped: TCheckBox;
    pnlImage: TPanel;
    Label1: TLabel;
    ScaleCombo: TComboBox;
    Panel2: TPanel;
    ImageInterpolate: TCheckBox;
    SelectionDelete1: TAction;
    SelectionMagnifier1: TAction;
    SelectionRubberband1: TAction;
    Selection1: TMenuItem;
    SelectionMagnifier11: TMenuItem;
    SelectionRubberband11: TMenuItem;
    SelectionDelete11: TMenuItem;
    ToolButton8: TToolButton;
    ScaleBar: TGaugeBar;
    Label6: TLabel;
    ToolButton10: TToolButton;
    procedure FileNew1Execute(Sender: TObject);
    procedure FileOpen1Execute(Sender: TObject);
    procedure FileClose1Execute(Sender: TObject);
    procedure FileCloseAll1Execute(Sender: TObject);
    procedure FileSave1Execute(Sender: TObject);
    procedure FileSaveAs1Execute(Sender: TObject);
    procedure EditCopy1Execute(Sender: TObject);
    procedure EditPaste1Execute(Sender: TObject);
    procedure EditUndo1Execute(Sender: TObject);
    procedure CaptureDesktop1Execute(Sender: TObject);
    procedure CaptureArea1Execute(Sender: TObject);
    procedure CaptureActive1Execute(Sender: TObject);
    procedure CaptureObject1Execute(Sender: TObject);
    procedure FileExit1Execute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure HelpAbout1Execute(Sender: TObject);
    procedure HelpContents1Execute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure OptionsMinimize1Execute(Sender: TObject);
    procedure OptionsAutomatic1Execute(Sender: TObject);
    procedure OptionsDelay1Execute(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure ViewCenter1Execute(Sender: TObject);
    procedure ViewStretch1Execute(Sender: TObject);
    procedure ViewResize1Execute(Sender: TObject);
    procedure ViewScale1Execute(Sender: TObject);
    procedure ViewNormal1Execute(Sender: TObject);
    procedure EditCrop1Execute(Sender: TObject);
    procedure MagnOpacityChange(Sender: TObject);
    procedure MagnMagnificationChange(Sender: TObject);
    procedure MagnRotationChange(Sender: TObject);
    procedure ScaleComboChange(Sender: TObject);
    procedure ImageInterpolateClick(Sender: TObject);
    procedure LayerOpacityChange(Sender: TObject);
    procedure LayerInterpolateClick(Sender: TObject);
    procedure CroppedClick(Sender: TObject);
    procedure LayerRescaleClick(Sender: TObject);
    procedure LayerResetScaleClick(Sender: TObject);
    procedure SelectionDelete1Execute(Sender: TObject);
    procedure SelectionMagnifier1Execute(Sender: TObject);
    procedure SelectionRubberband1Execute(Sender: TObject);
    procedure ImgViewMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure ImgViewMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer; Layer: TCustomLayer);
    procedure ImgViewMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure ImgViewScroll(Sender: TObject);
    procedure ImgViewDblClick(Sender: TObject);
    procedure ScaleBarChange(Sender: TObject);
  private
    { Private declarations }
    TabSheet: TTabSheet;
    Image: TImgView32;
    //ScrollBox: TScrollBox;
    bLeftDown: Boolean;
    FileName: string;
    FileExtension: string;
    FNE: string;
    FilePath: string;
    FilePathName: string;
    Folder: string;
    DefaultDirectory: string;
    CaptureStr: string;
    TmpFolder: string;
    TmpBmp: TBitmap;
    FSelection: TPositionedLayer;
    procedure SetSelection(Value: TPositionedLayer);
    function ApplyCropSettings: TRect;
  public
    { Public declarations }
    procedure AddControls(Sender: TObject);
    procedure UpdateControls;
    property Selection: TPositionedLayer read FSelection write SetSelection;
  protected
    RBLayer: TRubberBandLayer;
    procedure LayerMouseDown(Sender: TObject; Buttons: TMouseButton; Shift: TShiftState; X, Y: Integer);
    function CreatePositionedLayer: TPositionedLayer;
    function CreateRubberbandLayer: TRubberbandLayer;
    procedure PaintMagnifierHandler(Sender: TObject; Buffer: TBitmap32);
    procedure RBMouseDown(Sender: TObject; Buttons: TMouseButton; Shift: TShiftState; X, Y: Integer);
  end;

var
  FormMain: TFormMain;

implementation

uses Fullscrn, JPEG, CompressQual,  Clipbrd,  ShellApi, ScreenDelay, Math;

{$R *.DFM}

procedure TFormMain.FormCreate(Sender: TObject);
begin
  TmpFolder := '';
  OpenPictureDialog1.Filename := '';
  OpenPictureDialog1.FilterIndex := 1;
   // Create a temporary bitmaps for image manipulation
  TmpBmp := TBitmap.Create;
  Application.HelpFile := ExtractFilePath(Application.EXEName) + 'APPREHEND SCREEN CAPTURE.HLP';
  UpdateControls;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  TmpBmp.Free;
end;

procedure TFormMain.AddControls(Sender: TObject);
begin
  with PageControl1 do
  // Create a new Tabsheet
    TabSheet := TTabSheet.Create(Self);
  // Set the Tabsheet.PageControl to PageControl1
  TabSheet.PageControl := PageControl1;
  // Set the activepage to tabsheet
  PageControl1.ActivePage := TabSheet;
  with Tabsheet do
  begin
    // Create an image32 component
    Image := TImgView32.Create(Self);
    Image.Parent := TabSheet; //ScrollBox;
    Image.Align := alClient;
    Image.Visible := True;
    Image.ShowHint := True;
    Image.BitmapAlign := baTopLeft;
    Image.AutoSize := False;
    Image.Centered := False;
    Image.ScaleMode := smScale;
    Image.ParentShowHint := True;
    Image.Scale := 1;
    Image.ScrollBars.Size := 12;
    Image.ScrollBars.Increment := 2;
    Image.OnScroll := ImgViewScroll;
    //Image.Bitmap.SetSize(800, 600);
    //Image.Bitmap.Clear(clWhite);
    pnlImage.Visible := not Image.Bitmap.Empty;
    Image.OnMouseDown := ImgViewMouseDown;
    Image.OnMouseMove := ImgViewMouseMove;
    Image.OnMouseUp := ImgViewMouseUp;
    Image.OnDblClick := ImgViewDblClick;
    // the folowing two lines are the key to referencing the components later
    TabSheet.Tag := Integer(Image);
    // Set the caption of the tabsheet
    Caption := Format('Image%d', [PageControl1.ActivePage.PageIndex]);
    UpdateControls;
  end;
end;

procedure TFormMain.ImgViewScroll(Sender: TObject);
begin
  //
end;

procedure TFormMain.UpdateControls;
begin
  FileClose1.Enabled := PageControl1.PageCount <> 0;
  FileCloseAll1.Enabled := PageControl1.PageCount <> 0;
  FileSave1.Enabled := PageControl1.PageCount <> 0;
  FileSaveAs1.Enabled := PageControl1.PageCount <> 0;
  OptionsMinimize1.Enabled := PageControl1.PageCount <> 0;
  OptionsAutomatic1.Enabled := PageControl1.PageCount <> 0;
  EditCopy1.Enabled := PageControl1.PageCount <> 0;
  EditPaste1.Enabled := Clipboard.HasFormat(CF_PICTURE);
  EditCrop1.Enabled := PageControl1.PageCount <> 0;
  EditUndo1.Enabled := PageControl1.PageCount <> 0;
end;

procedure TFormMain.EditUndo1Execute(Sender: TObject);
begin
  if PageControl1.PageCount <> 0 then
    TImage32(PageControl1.ActivePage.Tag).Bitmap.Assign(TmpBmp);
end;

procedure TFormMain.CaptureDesktop1Execute(Sender: TObject);
begin
   // Create new image
  AddControls(Sender);
  if PageControl1.PageCount <> 0 then
  begin
      // Set file information
    TImage32(PageControl1.ActivePage.Tag).Bitmap.Assign(ASGScreenCapture1.CaptureDesktop);
    TImage32(PageControl1.ActivePage.Controls[0]).Tag := 1;
    (*ScrollBox := TScrollbox ( PageControl1.ActivePage.Controls[ 0 ] );
    with ScrollBox do
    begin
      HorzScrollBar.Range := TImage32 ( PageControl1.ActivePage.Tag ).Bitmap.Width;
      VertScrollBar.Range := TImage32 ( PageControl1.ActivePage.Tag ).Bitmap.Height;
    end;  *)
    ScaleBar.Enabled := not TImgView32(PageControl1.ActivePage.Tag).Bitmap.Empty;
    TImage32(PageControl1.ActivePage.Tag).Hint := 'Height: ' +
      IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Height) + ' pixels' +
      '  Width: ' + IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Width) + ' pixels';
    StatusBar1.Panels[1].Text := 'Height: ' + IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Height) +
      ' pixels' + '  Width: ' + IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Width) +
      ' pixels';
    Tabsheet.ImageIndex := 0;
  end;
end;

procedure TFormMain.CaptureArea1Execute(Sender: TObject);
begin
 // Create new image
  AddControls(Sender);
  if PageControl1.PageCount <> 0 then
  begin
      // Set file information
    Filename := 'Untitled';
      // Capture area of screen
    TImage32(PageControl1.ActivePage.Tag).Bitmap.Assign(ASGScreenCapture1.CaptureSelection);
    TImage32(PageControl1.ActivePage.Controls[0]).Tag := 1;
    (*ScrollBox := TScrollbox ( PageControl1.ActivePage.Controls[ 0 ] );
    with ScrollBox do
    begin
      HorzScrollBar.Range := TImage32 ( PageControl1.ActivePage.Tag ).Bitmap.Width;
      VertScrollBar.Range := TImage32 ( PageControl1.ActivePage.Tag ).Bitmap.Height;
    end; *)
    ScaleBar.Enabled := not TImgView32(PageControl1.ActivePage.Tag).Bitmap.Empty;
    Image.Hint := 'Height: ' +
      IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Height) + ' pixels' +
      '  Width: ' + IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Width) + ' pixels';
    StatusBar1.Panels[1].Text := 'Height: ' + IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Height) +
      ' pixels' + '  Width: ' + IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Width) +
      ' pixels';
  end;
  // set tabsheet glyph
  Tabsheet.ImageIndex := 2;
end;

procedure TFormMain.CaptureActive1Execute(Sender: TObject);
begin
 // Create new image
  AddControls(Sender);
  if PageControl1.PageCount <> 0 then
  begin
      // Set file information
    TImage32(PageControl1.ActivePage.Tag).Bitmap.Assign(ASGScreenCapture1.CaptureActiveWindow);
    TImage32(PageControl1.ActivePage.Controls[0]).Tag := 1;
    (* ScrollBox := TScrollbox ( PageControl1.ActivePage.Controls[ 0 ] );
    with ScrollBox do
    begin
      HorzScrollBar.Range := TImage32 ( PageControl1.ActivePage.Tag ).Bitmap.Width;
      VertScrollBar.Range := TImage32 ( PageControl1.ActivePage.Tag ).Bitmap.Height;
    end; *)
    ScaleBar.Enabled := not TImgView32(PageControl1.ActivePage.Tag).Bitmap.Empty;
    TImage32(PageControl1.ActivePage.Tag).Hint := 'Height: ' +
      IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Height) + ' pixels' +
      '  Width: ' + IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Width) + ' pixels';
    StatusBar1.Panels[1].Text := 'Height: ' + IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Height) +
      ' pixels' + '  Width: ' + IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Width) +
      ' pixels';
    // set tabsheet glyph
    Tabsheet.ImageIndex := 1;
  end;
end;

procedure TFormMain.CaptureObject1Execute(Sender: TObject);
begin
 // Create new image
  AddControls(Sender);
  if PageControl1.PageCount <> 0 then
  begin
     // Copy the image to the Image component