main.pas

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

begin
  // Set the initial directory of the OpenPictureDialog
  OpenPictureDialog1.Filter := GraphicFilter ( TGraphic );
  OpenPictureDialog1.DefaultExt := GraphicExtension ( TBitmap );
  if OpenPictureDialog1.Execute then
  begin
    BeginHourglass;
      // Add Controls to a new tabsheet
    AddControls ( Sender );
    ProgressBar1.Visible := True;
      // Set the caption of the tabsheet
    TabSheet.Caption := OpenPictureDialog1.FileName;
    FFileName := OpenPictureDialog1.FileName;
    Tabsheet.ImageIndex := 5;
    try
      LoadFile ( FFileName );
    except
      ShowMessage ( 'Error loading ' + FFileName + '.' );
      FFileName := '';
    end;
    FMultiPageFileName := OpenPictureDialog1.FileName;
  end;
  ShowImageDimensions;
  ShowImageFormat;
  ProgressBar1.Visible := False;
  EndHourglass;
end;

procedure TFormMain.FileClose1Execute ( Sender: TObject );
begin
  if PageControl1.PageCount <> 0 then begin
    if TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag = 1 then
    begin
      case MessageDlg ( PageControl1.ActivePage.Caption + ' is not saved. Save it?',
        mtConfirmation, [ mbYes, mbNo, mbCancel ], 0 ) of
        mrYes: FileSaveAs1Execute ( Self );
        mrNo: begin
            TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Destroy;
                   // Close the active page
            PageControl1.ActivePage.Free; // Closes and Frees the ActivePage
            PageControl1.SelectNextPage ( False );
            UpdateControls;
          end;
        mrCancel: Abort;
      end;
    end
    else
    begin
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Destroy;
          // Close the active page
      PageControl1.ActivePage.Free; // Closes and Frees the ActivePage
      PageControl1.SelectNextPage ( False );
      UpdateControls;
    end;
  end;
end;

procedure TFormMain.FileCloseAll1Execute ( Sender: TObject );
var
  i: Integer;
begin
   //Close All pages
  for i := PageControl1.PageCount - 1 downto 0 do
  begin
    if TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag = 1 then
    begin
      case MessageDlg ( PageControl1.ActivePage.Caption + ' is not saved. Save it?',
        mtConfirmation, [ mbYes, mbNo, mbCancel ], 0 ) of
        mrYes: FileSaveAs1Execute ( Self );
        mrNo: begin
            PageControl1.ActivePage := PageControl1.Pages[ i ];
            TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Destroy;
                // Close the active page
            PageControl1.ActivePage.Free; // Closes and Frees the ActivePage
            PageControl1.SelectNextPage ( False );
            UpdateControls;
          end;
        mrCancel: Abort;
      end;
    end
    else
    begin
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Destroy;
        // Close the active page
      PageControl1.ActivePage.Free; // Closes and Frees the ActivePage
      PageControl1.SelectNextPage ( False );
      UpdateControls;
    end;
  end;
end;

procedure TFormMain.FileSave1Execute ( Sender: TObject );
var
  Ext: string;
  DIBGraphic: TDibGraphic;
begin
  BeginHourglass;
  DIBGraphic := TDibGraphic ( TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic );
  if DIBGraphic = nil then begin
    EndHourglass;
    Exit;
  end;
  if ( FFileName = '' ) then
    FileSaveAs1Execute ( Sender )
  else begin
    Ext := AnsiUpperCase ( ExtractFileExt ( FFileName ) );
    if Ext = '' then Ext := '.Bmp';
    DIBGraphic := NewDibGraphic ( Ext );
    if DIBGraphic = nil then begin
      EndHourglass;
      Abort;
    end;
    EndHourglass;
    try
      DIBGraphic.Assign ( TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic );
      DIBGraphic.SaveToFile ( FFileName );
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := 0;
    finally
      EndHourglass;
      DIBGraphic.Free;
    end;
  end;
  EndHourglass;
end;

procedure TFormMain.FileSaveAs1Execute ( Sender: TObject );
var
  SaveDialog: TSavePictureDialog;
begin
  if PageControl1.PageCount <> 0 then
  begin
    SaveDialog := TSavePictureDialog.Create ( nil );
    try
      SaveDialog.Filter := GraphicFilter ( TDibGraphic );
      SaveDialog.DefaultExt := '*.bmp';
      if SaveDialog.Execute then begin
        FFileName := SaveDialog.FileName;
        if FileExists ( FFileName ) and
          ( MessageDlg ( 'File ' + FFileName + ' exists.'#13 + ' Overwrite ?',
          mtConfirmation, [ mbYes, mbNo ], 0 ) <> mrYes ) then
          Abort;
        FileSave1Execute ( Sender );
        PageControl1.ActivePage.Caption := FFilename;
      end;
    finally
      SaveDialog.Free;
    end;
  end;
end;

procedure TFormMain.FileExit1Execute ( Sender: TObject );
begin
  Close;
end;

procedure TFormMain.EditCopy1Execute ( Sender: TObject );
begin
  if TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).MouseHandler as TRubberBandMouseHandler <> nil
    then
    with TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).MouseHandler as TRubberBandMouseHandler do
      if SelectionActive then
      try
        CopySelectionToClipBoard;
      finally
      end
      else
        if TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic <> nil then
          Clipboard.Assign ( TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic );
  UpdateControls;
end;

procedure TFormMain.EditPaste1Execute ( Sender: TObject );
var
  DibGraphic: TDibGraphic;
begin
    // Create new image
  AddControls ( Sender );
  if Clipboard.HasFormat ( CF_BITMAP ) then begin
    if TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic is TDibGraphic then begin
      TDibGraphic ( TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic ).Assign ( Clipboard );
    end
    else begin
      DibGraphic := TDibGraphic.Create;
      try
        DibGraphic.Assign ( Clipboard );
        TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic := DibGraphic;
      finally
        DibGraphic.Free;
      end;
    end;
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := 0;
    FFileName := '';
    Tabsheet.ImageIndex := 7;
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Redraw ( True );
  end;
end;

procedure TFormMain.EditCrop1Execute ( Sender: TObject );
begin
  TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).SaveUndo;
  if TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).MouseHandler as TRubberBandMouseHandler <> nil
    then
    with TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).MouseHandler as TRubberBandMouseHandler do
      if SelectionActive then
      begin
        try
          CropToSelection;
        finally
        end;
        TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := 1;
        ShowImageDimensions;
      end
      else
        ShowMessage ( 'Please select an area of the image to crop.' );
  TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Invalidate;
end;

procedure TFormMain.HelpAbout1Execute ( Sender: TObject );
begin
  ShellAbout ( Application.Handle, 'Apprehend 2000 Screen Capture',
    'More info at: http://www.software.adirondack.ny.us', Application.Icon.Handle );
end;

procedure TFormMain.HelpContents1Execute ( Sender: TObject );
begin
  Application.HelpCommand ( HELP_FINDER, 0 );
end;

procedure TFormMain.FormCloseQuery ( Sender: TObject;var CanClose: Boolean );
var
  i: integer;
begin
  if PageControl1.PageCount <> 0 then begin
    for i := 0 to PageControl1.PageCount - 1 do begin
      if TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag = 1 then
      begin
        case MessageDlg ( PageControl1.ActivePage.Caption + ' is not saved. Save it?',
          mtConfirmation, [ mbYes, mbNo, mbCancel ], 0 ) of
          mrYes: FileSave1Execute ( Self );
          mrNo: CanClose := True;
          mrCancel: Abort;
        end;
      end;
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Free;
    // close the active page
      PageControl1.ActivePage.Free;
      PageControl1.SelectNextPage ( False );
    end;
  end;
  if Clipboard.HasFormat ( CF_PICTURE ) then
    case MessageDlg ( ' The clipboard contains an image. Remove image from Clipboard?',
      mtConfirmation, [ mbYes, mbNo ], 0 ) of
      mrYes: Clipboard.Clear;
      mrNo: CanClose := True;
    end; // case
  UpdateControls;
end;

procedure TFormMain.ImageScrollBoxImageMouseDown ( Sender: TObject;
  Button: TMouseButton;Shift: TShiftState;X, Y: Integer );
begin
  TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).SetFocus;
end;

procedure TFormMain.ImageScrollBoxImageMouseMove ( Sender: TObject;
  Shift: TShiftState;X, Y: Integer );
begin
  with TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).MouseHandler as TRubberBandMouseHandler do
    if not SelectionActive then
      StatusBar1.Panels[ 2 ].Text := ' ( ' + IntToStr ( X ) + ' , ' + IntToStr ( Y ) + ' ) ';
end;

function TFormMain.GetGraphic: TDibGraphic;
begin
  Result := nil;
  if PageControl1.PageCount <> 0 then
    Result := ( TDibGraphic ( TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic ) );
end;

procedure TFormMain.OnProgress ( const Sender: TObject;
  const PercentProgress: Byte );
begin
  if ( PercentProgress < 100 ) then begin
    ProgressBar1.Visible := True;
    ProgressBar1.Position := PercentProgress;
    ProgressBar1.Update;
    frmStatus.lblStatus.Update;
  end
  else begin
    ProgressBar1.Visible := False;
    ProgressBar1.Position := 0;
  end;
end;

procedure TFormMain.ShowImageDimensions;
begin
  if not TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic.Empty then
    StatusBar1.Panels[ 3 ].Text := ' Height: ' +
      IntToStr ( TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ]
        ).Graphic.BitmapInfo.BmpHeader.biHeight ) + ' pixels' +
      '  Width: ' + IntToStr ( TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ]
        ).Graphic.BitmapInfo.BmpHeader.biWidth ) +
      ' pixels '
  else
    StatusBar1.Panels[ 3 ].Text := '         ';
  TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Hint := 'Height: ' +
    IntToStr ( TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic.BitmapInfo.BmpHeader.biHeight
      ) + ' pixels' +
    '  Width: ' + IntToStr ( TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ]
      ).Graphic.BitmapInfo.BmpHeader.biWidth ) + ' pixels';
end;

procedure TFormMain.ShowImageFormat;
begin
  case GetGraphic.ImageFormat of
    ifBlackWhite: StatusBar1.Panels[ 1 ].Text := ' 1 bit Black & White ';
    ifGray16: StatusBar1.Panels[ 1 ].Text := ' 4 bit 16 shade gray ';
    ifGray256: StatusBar1.Panels[ 1 ].Text := ' 8 bit 256 shade gray ';
    ifColor16: StatusBar1.Panels[ 1 ].Text := ' 4 bit 16 colors ';
    ifColor256: StatusBar1.Panels[ 1 ].Text := ' 8 bit 256 colors ';
    ifTrueColor: StatusBar1.Panels[ 1 ].Text := ' 24 bit True color ';
  else
    StatusBar1.Panels[ 1 ].Text := ' Unknown image format ';
  end; // case
end;

procedure TFormMain.ShowZoomPercent;
var
  Zoom: single;
begin
  try
    Zoom := TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).ZoomPercent;
    ZoomCombo.Text := Format ( '%*.*f', [ 3, 0, Zoom ] );
  except
    { trap exception }
    ZoomCombo.Text := '100';
  end;
end;

procedure TFormMain.ImageLoaded;
var
  DIBGraphic: TDibGraphic;
begin
  DIBGraphic := GetGraphic;
  if DIBGraphic = nil then
    Exit;
end;

procedure TFormMain.OnAcquire ( const DibHandle: THandle;
  const XDpi: Word;
  const YDpi: Word;
  const CallBackData: LongInt );
var
  DIBGraphic: TDibGraphic;
  pScanInfo: TpScanInfo;
begin
  pScanInfo := TpScanInfo ( CallBackData );
  if pScanInfo^.MultiPage then begin
    pScanInfo^.Graphic.AssignFromDibHandle ( DibHandle );
    pScanInfo^.Graphic.XDotsPerInch := XDpi;
    pScanInfo^.Graphic.YDotsPerInch := YDpi;
    if pScanInfo^.Graphic.ImageFormat = ifBlackWhite then
      pScanInfo^.Graphic.Compression := tcGroup4
    else
      pScanInfo^.Graphic.Compression := tcPackBits;
    pScanInfo^.Stream.Seek ( 0, soFromBeginning );
    if pScanInfo^.ImageCount = 0 then
      pScanInfo^.Graphic.SaveToStream ( pScanInfo^.Stream )
    else
      pScanInfo^.Graphic.AppendToStream ( pScanInfo^.Stream );
      // display some visual feedback by displaying each image scanned one by one.
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Graphic := pScanInfo^.Graphic;