main.pas

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

var
  FormMain: TFormMain;

implementation

uses Fullscrn, Clipbrd, ShellApi, EnDcxGr, EnPrint, EnMisc, EnTransf, EnTifGr,
EnPngGr, EnBmpGr, EnIcoGr, EnWmfGr, EnJpgGr, EnReg, ScreenDelay, frmFrmt,
frmEffects, frmPOpt, frmStat, frmProperty;

{$R *.DFM}
type

  TpScanInfo = ^TScanInfo;
  TScanInfo = record
    MultiPage: Boolean; { supplementary info when MultiPage is True }
    Graphic: TTiffGraphic;
    Stream: TFileStream;
    ImageCount: LongInt;
  end;

function fileSize ( const FileName: string ): LongInt;
var
  SearchRec: TSearchRec;
begin { !Win32! -> GetFileSize }
  if FindFirst ( FileName, faAnyFile, SearchRec ) = 0
    then Result := SearchRec.Size
  else Result := 0;
  FindClose ( SearchRec );
end;

procedure TFormMain.FormCreate ( Sender: TObject );
begin
  OpenPictureDialog1.Filename := '';
  OpenPictureDialog1.FilterIndex := 1;
  Application.HelpFile := ExtractFilePath ( Application.EXEName ) + 'APPREHEND SCREEN CAPTURE.HLP';
  Application.Onhint := ShowHint;
  FUndoGraphic := TDibGraphic.Create;
  FScanner := TScanner.Create;
  if FindDibGraphicClass ( '*.BMP' ) = nil then begin
    TPicture.UnRegisterGraphicClass ( Graphics.TBitmap );
    RegisterDibGraphic ( 'BMP', 'Bitmap file', TBitmapGraphic );
  end;
  if FindDibGraphicClass ( '*.ICO' ) = nil then begin
    TPicture.UnRegisterGraphicClass ( TIcon );
    RegisterDibGraphic ( 'ICO', 'Windows icon', TIconGraphic );
  end;
  if FindDibGraphicClass ( '*.WMF' ) = nil then begin
    TPicture.UnRegisterGraphicClass ( TMetaFile );
    RegisterDibGraphic ( 'WMF', 'Windows meta file', TMetaFileGraphic );
    RegisterDibGraphic ( 'EMF', 'Enhanced meta file', TMetaFileGraphic );
  end;
  UpdateControls;
end;

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

procedure TFormMain.AddControls ( Sender: TObject );
begin
  with PageControl1 do
    // Create a new Tabsheet
    TabSheet := TTabSheet.Create ( Self );
    // Set the Tabsheet.PageControl to PageControl
  TabSheet.PageControl := PageControl1;
    // Set the activepage to tabsheet
  PageControl1.ActivePage := TabSheet;
  with Tabsheet do begin
      // Create a ImageScrollbox component
    ImageScrollBox := TImageScrollBox.Create ( Self );
    ImageScrollBox.Align := alClient;
    ImageScrollBox.Visible := True;
    ImageScrollBox.Parent := TabSheet;
    ImageScrollBox.HorzScrollBar.Tracking := True;
    ImageScrollBox.VertScrollBar.Tracking := True;
    ImageScrollBox.MouseMode := mmUser;
    ImageScrollBox.Tag := 0;
    ImageScrollBox.OnImageMouseMove := ImageScrollBoxImageMouseMove;
    ImageScrollBox.OnImageMouseDown := ImageScrollBoxImageMouseDown;
    ImageScrollBox.OnZoomChange := ImageScrollBoxZoomChange;
    Rubberband := TRubberBandMouseHandler.Create ( ImageScrollBox );
    ImageScrollBox.MouseHandler := Rubberband;
    ImageScrollBox.PopupMenu := PopupMenu1;
    with ImageScrollBox.MouseHandler as TRubberBandMouseHandler do begin
      ForegroundColor := clRed;
      BackgroundColor := clWhite;
    end;
    ImageScrollBox.OnRubberbandChange := ImageScrollBoxRubberbandChange;
    with ImageScrollBox do begin
      HorzScrollBar.Tracking := True;
      VertScrollBar.Tracking := True;
      HorzScrollBar.Range := ImageScrollBox.Graphic.Width;
      VertScrollBar.Range := ImageScrollBox.Graphic.Height;
    end;
      // the folowing two lines are the key to referencing the components later
    TabSheet.Tag := Integer ( ImageScrollBox );
      // Set the caption of the tabsheet
    Caption := Format ( 'Image%d', [ PageControl.ActivePage.PageIndex ] );
    UpdateControls;
  end;
end;

procedure TFormMain.ProgressUpdate ( Sender: TObject;Stage: TProgressStage;
  PercentDone: Byte;RedrawNow: Boolean;const R: TRect;const Msg: string );
var
  Progress: string;
begin
  if Stage = psRunning then
  begin
    Caption := Format ( '%d%%', [ PercentDone ] );
    Progress := Format ( '%d%', [ PercentDone ] );
    ProgressBar1.Position := PercentDone;
  end
  else
  begin
    Caption := 'Apprehend 2001 Envision Demo';
  end;
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;
  ImageType1.Enabled := PageControl1.PageCount <> 0;
  ImageBlackAndWhite1.Enabled := PageControl1.PageCount <> 0;
  ImageShadesOfGray16.Enabled := PageControl1.PageCount <> 0;
  ImageShadesOfGray256.Enabled := PageControl1.PageCount <> 0;
  ImageSixteenColors1.Enabled := PageControl1.PageCount <> 0;
  ImageColors256.Enabled := PageControl1.PageCount <> 0;
  ImageTrueColor1.Enabled := PageControl1.PageCount <> 0;
  EditUndo1.Enabled := PageControl1.PageCount <> 0;
  FitButton.Enabled := PageControl1.PageCount <> 0;
  EffectsButton.Enabled := PageControl1.PageCount <> 0;
  TypeButton.Enabled := PageControl1.PageCount <> 0;
  RotateButton.Enabled := PageControl1.PageCount <> 0;
  FitActualSize1.Enabled := PageControl1.PageCount <> 0;
  FitWidth1.Enabled := PageControl1.PageCount <> 0;
  FitHeight1.Enabled := PageControl1.PageCount <> 0;
  FitFullPage1.Enabled := PageControl1.PageCount <> 0;
  FitPercent1.Enabled := PageControl1.PageCount <> 0;
  FitToPage1.Enabled := PageControl1.PageCount <> 0;
  PictureEffects1.Enabled := PageControl1.PageCount <> 0;
  EffectsNegative1.Enabled := PageControl1.PageCount <> 0;
  EffectsAntialis1.Enabled := PageControl1.PageCount <> 0;
  EffectsSharpen1.Enabled := PageControl1.PageCount <> 0;
  EffectsSmoothern1.Enabled := PageControl1.PageCount <> 0;
  EffectsEdgeDetection1.Enabled := PageControl1.PageCount <> 0;
  EffectsEmboss1.Enabled := PageControl1.PageCount <> 0;
  EffectsGamma1.Enabled := PageControl1.PageCount <> 0;
  FilePrint1.Enabled := PageControl1.PageCount <> 0;
  EditUndo1.Enabled := PageControl1.PageCount <> 0;
  ZoomButton.Enabled := PageControl1.PageCount <> 0;
  Properties1.Enabled := PageControl1.PageCount <> 0;
  ConvertToGray1.Enabled := PageControl1.PageCount <> 0;
  Color1.Enabled := PageControl1.PageCount <> 0;
  Brightness1.Enabled := PageControl1.PageCount <> 0;
  Contrast1.Enabled := PageControl1.PageCount <> 0;
  Flip1.Enabled := PageControl1.PageCount <> 0;
  Rotate11.Enabled := PageControl1.PageCount <> 0;
  Reset1.Enabled := PageControl1.PageCount <> 0;
  ResetButton.Enabled := PageControl1.PageCount <> 0;
  if PageControl1.PageCount = 0 then begin
    ZoomCombo.Text := '100';
    StatusBar1.Panels[ 0 ].Text := '';
    StatusBar1.Panels[ 1 ].Text := '';
    StatusBar1.Panels[ 2 ].Text := '';
    StatusBar1.Panels[ 3 ].Text := '';
  end;
  ZoomCombo.Enabled := PageControl1.PageCount <> 0;
end;

procedure TFormMain.EditUndo1Execute ( Sender: TObject );
begin
  if not TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).UndoEmpty then begin
    BeginHourglass;
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Undo;
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Redraw ( True );
    ShowImageFormat;
    ShowImageDimensions;
    EndHourglass;
  end
  else
    EditUndo1.Enabled := not TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).UndoEmpty;
end;

procedure TFormMain.CaptureDesktop1Execute ( Sender: TObject );
var
  DibGraphic: TDibGraphic;
begin
  Application.Minimize;
   // Give screen time to refresh by delay
  Sleep ( 500 );
   // Create new image
  AddControls ( Sender );
  ProgressBar1.Visible := True;
  Tabsheet.ImageIndex := 0;
  DibGraphic := TDibGraphic.Create;
  try
    DibGraphic.Assign ( ASGScreenCapture1.CaptureDesktop );
    TImageScrollBox ( PageControl1.ActivePage.Tag ).Graphic := DibGraphic;
  finally
    DibGraphic.Free;
  end;
   // Set the caption of the tabsheet
  TabSheet.Caption := Format ( 'Untitled %d', [ PageControl1.ActivePage.PageIndex ] );
  TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := TImageScrollBox (
    PageControl1.ActivePage.Controls[ 0 ] ).Tag + 1;
  FFileName := '';
  TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).HorzScrollBar.Range := TImageScrollBox (
    PageControl1.ActivePage.Controls[ 0 ] ).Graphic.Width;
  TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).VertScrollBar.Range := TImageScrollBox (
    PageControl1.ActivePage.Controls[ 0 ] ).Graphic.Height;
  // show image dimensions
  if not TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic.Empty then begin
    ShowImageDimensions;
    ShowImageFormat;
  end;
  ProgressBar1.Visible := False;
  Application.Restore;
end;

procedure TFormMain.CaptureArea1Execute ( Sender: TObject );
var
  DibGraphic: TDibGraphic;
begin
  Application.Minimize;
 // Create new image
  AddControls ( Sender );
  if PageControl1.PageCount <> 0 then
  begin
      // Set file information
    FFilename := 'Untitled';
    DibGraphic := TDibGraphic.Create;
    try
      // Capture area of screen
      DibGraphic.Assign ( ASGScreenCapture1.CaptureSelection );
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic := DibGraphic;
    finally
      DibGraphic.Free;
    end;
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := 1;
    // show image dimensions
    if not TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic.Empty then
      ShowImageDimensions;
    Tabsheet.ImageIndex := 2;
    ShowImageFormat;
  end;
  Application.Restore;
end;

procedure TFormMain.CaptureActive1Execute ( Sender: TObject );
var
  DibGraphic: TDibGraphic;
begin
  Application.Minimize;
 // Create new image
  AddControls ( Sender );
  if PageControl1.PageCount <> 0 then
  begin
      // Set file information
    DibGraphic := TDibGraphic.Create;
    try
      // Capture active window
      DibGraphic.Assign ( ASGScreenCapture1.CaptureActiveWindow );
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic := DibGraphic;
    finally
      DibGraphic.Free;
    end;
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := 1;
    // show image dimensions
    if not TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic.Empty then
      ShowImageDimensions;
    Tabsheet.ImageIndex := 1;
    ShowImageFormat;
  end;
  Application.Restore;
end;

procedure TFormMain.CaptureObject1Execute ( Sender: TObject );
var
  DibGraphic: TDibGraphic;
begin
  Application.Minimize;
 // Create new image
  AddControls ( Sender );
  if PageControl1.PageCount <> 0 then
  begin
     // Copy the image to the Image component
    DibGraphic := TDibGraphic.Create;
    try
      // Capture object
      DibGraphic.Assign ( ASGScreenCapture1.CaptureObject );
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic := DibGraphic;
    finally
      DibGraphic.Free;
    end;
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := 1;
    // show image dimensions
    if not TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic.Empty then begin
      ShowImageDimensions;
      ShowImageFormat;
    end;
  end; {If}
  Tabsheet.ImageIndex := 3;
  Application.Restore;
end;

procedure TFormMain.FileNew1Execute ( Sender: TObject );
begin
  AddControls ( Sender );
   // Set the caption of the tabsheet
  TabSheet.Caption := Format ( 'Untitled%d', [ PageControl1.ActivePage.PageIndex ] );
   // set tabsheet glyph
  Tabsheet.ImageIndex := 6;
end;

procedure TFormMain.ShowHint ( Sender: TObject );
begin
  if Application.Hint <> '' then
    StatusBar1.Panels[ 0 ].Text := Application.Hint;
end;

procedure TFormMain.LoadFile ( const FileName: string );
var
  DIBGraphic: TDibGraphic;
  FileStream: TFileStream;
begin
  BeginHourglass;
  try
    DIBGraphic := NewDibGraphic ( FileName );
    try
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic := DIBGraphic;
    finally
      DIBGraphic.Free;
    end;
    DIBGraphic := TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic as TDibGraphic;
    FFileName := FileName;
      // Set the caption of the tabsheet
    if Filename = '' then
      TabSheet.Caption := Format ( 'Untitled%d', [ PageControl1.ActivePage.PageIndex ] )
    else
      Tabsheet.Caption := ExtractFilename ( FileName );
      // call LoadFromFile after the graphic has been assigned to the image to work with animated images.
    BeginHourglass;
    FileStream := TFileStream.Create ( FFileName, fmOpenRead );
    try
      FileStream.Seek ( 0, soFromBeginning );
      DIBGraphic.LoadFromStream ( FileStream );
    finally
      FileStream.Free;
      EndHourglass;
    end;
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := 0;
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).HorzScrollBar.Range := TImageScrollBox (
      PageControl1.ActivePage.Controls[ 0 ] ).Graphic.Width;
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).VertScrollBar.Range := TImageScrollBox (
      PageControl1.ActivePage.Controls[ 0 ] ).Graphic.Height;
  finally
    EndHourglass;
  end;
end;

procedure TFormMain.FileOpen1Execute ( Sender: TObject );