frmmain.pas

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

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 2000 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
   // 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;
   // 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;
  finally DibGraphic.Free; end;
end;

procedure TFormMain.CaptureArea1Execute(Sender: TObject);
var
  DibGraphic: TDibGraphic;
begin
 // 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;
    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;
    finally DibGraphic.Free; end;
  end;
end;

procedure TFormMain.CaptureActive1Execute(Sender: TObject);
var
  DibGraphic: TDibGraphic;
begin
 // 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;
      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;
      finally DibGraphic.Free; end;
  end;
end;

procedure TFormMain.CaptureObject1Execute(Sender: TObject);
var
  DibGraphic: TDibGraphic;
begin
 // 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;
      TImageScrollBox(PageControl1.ActivePage.Controls[0]).Tag := 1;
      // show image dimensions
      if not TImageScrollBox(PageControl1.ActivePage.Controls[0]).Graphic.Empty then begin
        ShowImageDimensions;
        ShowImageFormat;
      end;
    finally DibGraphic.Free; end;
  end; {If}
  Tabsheet.ImageIndex := 3;
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;
      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.
     FileStream := TFileStream.Create(FFileName, fmOpenRead);
    try
      FileStream.Seek(0, soFromBeginning);
      DIBGraphic.LoadFromStream(FileStream);
    finally FileStream.Free; 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 DIBGraphic.Free; end;
  finally EndHourglass; end;
end;

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

procedure TFormMain.FileClose1Execute(Sender: TObject);
begin
  if PageControl1.PageCount <> 0 then begin