frmmain.pas

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

//------------------------------------------------------------------------------
//  Apprehend 2001 Version: 1.1
//  Copyright (c) 2001 : Adirondack Software & Graphics
//  Created            : 1-09-1992
//  Last Modification  : 06-04-2001
//  Description        : FrmMain Unit
//  Known Problems     : 1.0 released 6/3/01
//                       1.1 Minor Fix to remove two components referred to that
//                           were not provided. updated 6/4/01
//                       Rubberbanding only supported with bitmap images
//                       Cropping of JPG images not supported
//------------------------------------------------------------------------------

unit FrmMain;

interface

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

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;
    ToolButton19: TToolButton;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    FileNewItem: TMenuItem;
    FileOpenItem: TMenuItem;
    FileCloseItem: TMenuItem;
    FileCloseAll2: TMenuItem;
    FileSaveItem: TMenuItem;
    FileSaveAsItem: 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;
    EditCopyToSel1: TAction;
    CopyToSel1: TMenuItem;
    N2: TMenuItem;
    Device1: TMenuItem;
    EditDevice1: TAction;
    EditBlackandWhite1: TAction;
    BlackandWhite1: TMenuItem;
    Edit16Color1: TAction;
    Edit256Color1: TAction;
    Edit15Bit1: TAction;
    Edit16Bit1: TAction;
    Edit24Bit1: TAction;
    Edit32Bit1: TAction;
    N16Color1: TMenuItem;
    N256Color1: TMenuItem;
    N15Bit1: TMenuItem;
    N16Bit1: TMenuItem;
    N24Bit1: TMenuItem;
    N32Bit1: TMenuItem;
    PopupMenu1: TPopupMenu;
    Copy1: TMenuItem;
    CopySelection1: TMenuItem;
    Paste1: TMenuItem;
    Crop2: TMenuItem;
    ColorDepth2: TMenuItem;
    Undo2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N6: TMenuItem;
    Device2: TMenuItem;
    N16Color2: TMenuItem;
    N256Color2: TMenuItem;
    N15BitHighColor1: TMenuItem;
    N16BitHighColor1: TMenuItem;
    N24BitColor1: TMenuItem;
    N32BitColor1: TMenuItem;
    BlackandWhite2: TMenuItem;
    N7: TMenuItem;
    FileProperties1: TAction;
    Colors1: TMenuItem;
    ImageRotate1: TAction;
    ImageFlipHorzontal1: TAction;
    ImageFlipVertical1: TAction;
    EditGrayscale1: TAction;
    ImageResize1: TAction;
    ImageZoom1: TAction;
    Close1: TMenuItem;
    Label1: TLabel;
    TrackBar1: TTrackBar;
    PctBtn: TSpeedButton;
    ExportForArticle1: TAction;
    ToolButton20: TToolButton;
    ToolButton23: TToolButton;
    ToolButton8: TToolButton;
    ToolButton24: TToolButton;
    PrintDialog1: TPrintDialog;
    PrinterSetupDialog1: TPrinterSetupDialog;
    FilePrint1: TAction;
    FilePrint11: TMenuItem;
    N1: TMenuItem;
    FilePrintSetup1: TAction;
    procedure FileNew1Execute(Sender: TObject);
    procedure NewImageDblClick(Sender: TObject);
    procedure NewImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure NewImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure NewImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ProgressUpdate(Sender: TObject; Stage: TProgressStage;
      PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
    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 EditCrop1Execute(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 EditDevice1Execute(Sender: TObject);
    procedure EditBlackandWhite1Execute(Sender: TObject);
    procedure Edit16Color1Execute(Sender: TObject);
    procedure Edit256Color1Execute(Sender: TObject);
    procedure Edit15Bit1Execute(Sender: TObject);
    procedure Edit16Bit1Execute(Sender: TObject);
    procedure Edit24Bit1Execute(Sender: TObject);
    procedure Edit32Bit1Execute(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure PctBtnClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FilePrint1Execute(Sender: TObject);
    procedure FilePrintSetup1Execute(Sender: TObject);
  private
    { Private declarations }
    TabSheet: TTabSheet;
    ScrollBox: TScrollBox;
    Image: TImage;
    bLeftDown: Boolean;
    pointStart: TPoint;
    pointEnd: TPoint;
    RubberbandVisible: Boolean;
    FileName: string;
    FileExtension: string;
    FNE: string;
    FilePathName: string;
    Folder: string;
    DefaultDirectory: string;
    CaptureStr: string;
    TmpFolder: string;
    TmpBmp: TBitmap;
    CL, CT, CB, CR2, NW, NH: integer;
    ErrorSavingJPGFile: Boolean;
    procedure DrawRubberband;
    procedure CopySelectionToClipboard;
  public
    { Public declarations }
    procedure AddControls(Sender: TObject);
    procedure UpdateControls;
    procedure ClearStatusBar;

  end;

var
  FormMain: TFormMain;

implementation

uses
  Fullscrn, Clipbrd, ShellApi, ScreenDelay, inifiles, FileCtrl;

{$R *.DFM}

procedure TFormMain.FormCreate(Sender: TObject);
var
  IniFile: TIniFile;
  IniFilName: string;
begin
  TmpFolder := 'C:\My Documents';
  IniFilName := ChangeFileExt(Application.EXEName, '.INI');
  IniFile := TIniFile.Create(IniFilName);
  try
    with IniFile do
      DefaultDirectory := ReadString('Default', 'Folder', 'C:\My Documents');
  finally IniFile.Free; end;
  ErrorSavingJPGFile := False;
  RubberbandVisible := False;
  OpenPictureDialog1.Filename := '';
  SavePictureDialog1.Filename := '';
   // 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);
var
  IniFile: TIniFile;
  IniFilName: string;
begin
  TmpBmp.Free;
  IniFilName := ChangeFileExt(Application.EXEName, '.INI');
  IniFile := TIniFile.Create(IniFilName);
  try
    IniFile.WriteString('Default', 'Folder', DefaultDirectory);
  finally IniFile.Free; end;
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 a Scrollbox component
    ScrollBox := TScrollBox.Create(Self);
    ScrollBox.Align := alClient;
    ScrollBox.Visible := True;
    ScrollBox.Parent := TabSheet;
    // Create an image component
    Image := TImage.Create(Self);
    Image.Parent := ScrollBox;
    Image.Align := alNone;
    Image.Left := 0;
    Image.Top := 0;
    Image.AutoSize := False;
    Image.Center := False;
    Image.Stretch := True;
    Image.Visible := True;
    Image.ShowHint := False;
    Image.ParentShowHint := True;
    Image.OnProgress := ProgressUpdate;
    Image.OnDblClick := NewImageDblClick;
    Image.OnMouseDown := NewImageMouseDown;
    Image.OnMouseUp := NewImageMouseUp;
    Image.OnMouseMove := NewImageMouseMove;
    Image.PopupMenu := PopupMenu1;
    // 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]);
    bLeftDown := false;
    Pointstart.X := 0;
    Pointstart.Y := 0;
    Pointend.X := 0;
    Pointend.Y := 0;
    UpdateControls;