frmmain.pas

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

    TImage32(PageControl1.ActivePage.Tag).Bitmap.Assign(ASGScreenCapture1.CaptureObject);
    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;
    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; {If}
  // set tabsheet glyph
  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.FileOpen1Execute(Sender: TObject);
begin
  // Set the initial directory of the OpenPictureDialog
  OpenPictureDialog1.InitialDir := FilePath;
  OpenPictureDialog1.DefaultExt := GraphicExtension(TBitmap);
  if OpenPictureDialog1.Execute then
  begin
    Screen.Cursor := crHourglass;
    ProgressBar1.Visible := True;
    // Add Image Controls to a new tabsheet
    AddControls(Sender);
    if PageControl1.PageCount <> 0 then
    begin
      try
        TImgView32(PageControl1.ActivePage.Tag).Bitmap.LoadFromFile(OpenPictureDialog1.Filename);
        TImgView32(PageControl1.ActivePage.Tag).Tag := 0;
      except
        Screen.Cursor := crDefault;
        ShowMessage('Error loading image');
      end;
      if TImgView32(PageControl1.ActivePage.Tag).Bitmap.Empty then exit;
      TabSheet.Caption := ExtractFileName(OpenPictureDialog1.Filename);
         // set tabsheet glyph
      Tabsheet.ImageIndex := 5;
      TImgView32(PageControl1.ActivePage.Tag).Refresh;
      TImgView32(PageControl1.ActivePage.Tag).Hint := 'Height: ' + IntToStr(TImgView32(PageControl1.ActivePage.Tag).Bitmap.Height) +
        ' pixels' + '  Width: ' + IntToStr(TImgView32(PageControl1.ActivePage.Tag).Bitmap.Width) +
        ' pixels';
      StatusBar1.Panels[1].Text := 'Height: ' + IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Height) +
        ' pixels' + '  Width: ' + IntToStr(TImgView32(PageControl1.ActivePage.Tag).Bitmap.Width) +
        ' pixels';
    end;
    ProgressBar1.Visible := False;
    ScaleBar.Enabled := not TImgView32(PageControl1.ActivePage.Tag).Bitmap.Empty;
    Screen.Cursor := crDefault;
  end;
end;

procedure TFormMain.FileClose1Execute(Sender: TObject);
begin
  if PageControl1.PageCount <> 0 then begin
    if TImage32(PageControl1.ActivePage.Tag).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
            TImage32(PageControl1.ActivePage.Tag).Destroy;
                   // Close the active page
            PageControl1.ActivePage.Free; // Closes and Frees the ActivePage
            PageControl1.SelectNextPage(False);
            UpdateControls;
          end;
        mrCancel: Abort;
      end;
    end
    else
    begin
      TImage32(PageControl1.ActivePage.Tag).Destroy;
          // Close the active page
      PageControl1.ActivePage.Free; // Closes and Frees the ActivePage
      PageControl1.SelectNextPage(False);
      UpdateControls;
      ScaleBar.Enabled := PageControl1.PageCount <> 0;
    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 TImage32(PageControl1.ActivePage.Tag).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];
            TImage32(PageControl1.ActivePage.Tag).Destroy;
                   //TRubberbandLayer32( PageControl1.ActivePage.Tag ).Free;
                   // Close the active page
            PageControl1.ActivePage.Free; // Closes and Frees the ActivePage
            PageControl1.SelectNextPage(False);
            UpdateControls;
          end;
        mrCancel: Abort;
      end;
    end
    else
    begin
      TImage32(PageControl1.ActivePage.Tag).Destroy;
        //TRubberbandLayer32( PageControl1.ActivePage.Tag ).Free;
        // Close the active page
      PageControl1.ActivePage.Free; // Closes and Frees the ActivePage
      PageControl1.SelectNextPage(False);
      UpdateControls;
    end;
  end;
  ScaleBar.Enabled := not TImgView32(PageControl1.ActivePage.Tag).Bitmap.Empty;
end;

procedure TFormMain.FileSave1Execute(Sender: TObject);
begin
  if PageControl1.PageCount <> 0 then
  begin
      // Save current file
    if PageControl1.PageCount <> 0 then
    begin
      Screen.Cursor := crHourglass;
      if length(FileExtension) = 0 then
        FileExtension := '.jpg';
      if length(FileName) = 0 then
        FileName := 'Untitled' + CaptureStr;
      if length(Folder) = 0 then
        Folder := DefaultDirectory + '\';
      FNE := FileName + FileExtension;
      FilePathName := Folder + FileName + FileExtension;
         // Set JPEG compression quality
      if FileExtension = '.jpg' then
      begin
        with TImage32(PageControl1.ActivePage.Tag) do
          if Bitmap <> nil then begin
            try
              QualityForm := TQualityForm.Create(Self);
                     // Assign jpeg image to quality form picture
              QualityForm.Picture.Assign(TJPEGImage(TImage32(PageControl1.ActivePage.Tag).Bitmap
                ));
                     // Show quality form
              QualityForm.ShowModal;
            except
              QualityForm.Free;
            end;
          end;
            // Assign jpeg image to tab control picture
        TJPEGImage(TImage32(PageControl1.ActivePage.Tag).Bitmap).Assign(QualityForm.Picture);
      end;
         // If file exists then delete it
      if FileExists(FilePathName) then
            // Prompt user to delete file
        if MessageDlg(FilePathName + ' exists, Delete?', mtInformation, [mbYes, mbNo], 0) = mrYes then
          DeleteFile(FilePathName);
      try
        TImage32(PageControl1.ActivePage.Tag).Bitmap.SaveToFile(FilePathName);
      except
        on EInvalidGraphic do
          MessageDlg('Error saving file,' + FilePathName, mtWarning, [mbOK], 0);
      end;
         // Reload the file to show compression
      try
        TImage32(PageControl1.ActivePage.Tag).Bitmap.LoadFromFile(FilePathName);
      except
        on EInvalidGraphic do
          TImage32(PageControl1.ActivePage.Tag).Bitmap := nil;
      end;
      PageControl1.ActivePage.Caption := ExtractFilename(FilePathName);
      Screen.Cursor := crDefault;
    end;
  end;
end;

procedure TFormMain.FileSaveAs1Execute(Sender: TObject);
begin
  if PageControl1.PageCount <> 0 then
  begin
      // Save current file under new name
    if length(TmpFolder) = 0 then
      SavePictureDialog1.InitialDir := DefaultDirectory
    else
      SavePictureDialog1.InitialDir := TmpFolder;
    if length(Folder) = 0 then
      Folder := ExtractFilePath(FilePathName);
    if length(Folder) = 0 then
      Folder := DefaultDirectory;
    SavePictureDialog1.Filename := '';
    SavePictureDialog1.Filename := ExtractFileName(SavePictureDialog1.Filename);
    if length(SavePictureDialog1.Filename) = 0 then
      SavePictureDialog1.Filename := '*';
    SavePictureDialog1.Filename := SavePictureDialog1.Filename + '.' +
      SavePictureDialog1.DefaultExt;

    FNE := FileName + FileExtension;
    FilePathName := Folder + FileName + FileExtension;
    SavePictureDialog1.InitialDir := Folder;

    if SavePictureDialog1.Execute then
    begin
      FileExtension := ExtractFileExt(SavePictureDialog1.Filename);

      if length(FileExtension) = 0 then
        FileExtension := '.jpg';
            // Set JPEG compression quality
      if FileExtension = '.jpg' then
      begin
            // Assign jpeg image to quality form picture
        if TImage32(PageControl1.ActivePage.Tag).Bitmap <> nil then begin
          try
            QualityForm := TQualityForm.Create(Self);
            QualityForm.Picture.Assign(TJPEGImage(TImage32(PageControl1.ActivePage.Tag).Bitmap));
            // Show jpg image quality form
            QualityForm.ShowModal;
          except
            QualityForm.Free;
          end;
        end;
        // Assign jpeg image to tab control picture
        TJPEGImage(TImage32(PageControl1.ActivePage.Tag).Bitmap).Assign(QualityForm.Picture);
      end;

      // Save image to file
      try
        TImage32(PageControl1.ActivePage.Tag).Bitmap.SaveToFile(SavePictureDialog1.Filename);
      except
        on EInvalidGraphic do
          MessageDlg('Error saving file,' + Filename, mtWarning, [mbOK], 0);
      end;

      FilePathName := SavePictureDialog1.Filename;
      Folder := ExtractFilePath(SavePictureDialog1.Filename);
      Filename := ExtractFileName(FilePathName);
      FileExtension := ExtractFileExt(SavePictureDialog1.Filename);
      FNE := FileName + FileExtension;

      // If JPEG image then reload the file to show compression
      if FileExtension = '.jpg' then
      try
        TImage32(PageControl1.ActivePage.Tag).Bitmap.LoadFromFile(FilePathName);
      except
        on EInvalidGraphic do
          TImage32(PageControl1.ActivePage.Tag).Bitmap := nil;
      end;
      PageControl1.ActivePage.Caption := ExtractFilename(SavePictureDialog1.Filename);
    end;
  end;
  TImage32(PageControl1.ActivePage.Tag).Tag := 1;
end;

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

procedure TFormMain.EditCopy1Execute(Sender: TObject);
begin
  if PageControl1.PageCount <> 0 then begin
    Screen.Cursor := crHourglass;
    Clipboard.Assign(TImage32(PageControl1.ActivePage.Tag).Bitmap);
    UpdateControls;
    Screen.Cursor := crDefault;
  end;
end;

procedure TFormMain.EditPaste1Execute(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  if Clipboard.HasFormat(CF_PICTURE) then { is there a bitmap on the Clipboard? }
  begin
    AddControls(Sender);
    // Set the caption of the tabsheet
    TabSheet.Caption := Format('Untitled%d', [PageControl1.ActivePage.PageIndex]);
    Bitmap := TBitmap.Create; { create bitmap to hold the contents on the Clipboard }
    try
      Bitmap.Assign(Clipboard); { get the bitmap off the Clipboard }
      TImage32(PageControl1.ActivePage.Tag).Bitmap.Assign(Bitmap); { copy the bitmap to the Image }
      TImage32(PageControl1.ActivePage.Tag).Tag := 1;
      TImage32(PageControl1.ActivePage.Tag).Refresh;
    finally
      Bitmap.Free;
    end;
  end;
end;

procedure TFormMain.HelpAbout1Execute(Sender: TObject);
begin
  ShellAbout(Application.Handle, 'Apprehend 2001 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 TImage(PageControl1.ActivePage.Tag).Tag = 1 then
      begin
        case MessageDlg(PageControl1.ActivePage.Caption + ' is not saved. Save it?',
          mtConfirmation, [mbYes, mbNo, mbCancel], 0) of
          mrYes: FileSaveAs1Execute(Self);
          mrNo: Canclose := True;
          mrCancel: Abort;
        end;
      end;
      TImage32(PageControl1.ActivePage.Tag).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.OptionsMinimize1Execute(Sender: TObject);
begin
  Minimize1.Checked := not Minimize1.Checked;
  ASGScreenCapture1.Minimize := Minimize1.Checked;
end;

procedure TFormMain.OptionsAutomatic1Execute(Sender: TObject);
begin
  Automatic1.Checked := not Automatic1.Checked;
  ASGScreenCapture1.Auto := Automatic1.Checked;
end;

procedure TFormMain.OptionsDelay1Execute(Sender: TObject);
begin
  DelayDlg.edScreenDelay.Text := IntToStr(ASGScreenCapture1.Delay);
  if DelayDlg.ShowModal = mrOk then
    ASGScreenCapture1.Delay := StrToInt(DelayDlg.edScreenDelay.Text);
end;

procedure TFormMain.PageControl1Change(Sender: TObject);
begin
  UpdateControls;
  // show image dimensions
  StatusBar1.Panels[1].Text := ' Height: ' +
    IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Height) + ' pixels' +
    '  Width: ' + IntToStr(TImage32(PageControl1.ActivePage.Tag).Bitmap.Width) +
    ' pixels ';
  StatusBar1.Panels[2].Text := ' ';
  StatusBar1.Panels[3].Text := ' ';
end;

procedure TFormMain.ViewCenter1Execute(Sender: TObject);
begin
  Center1.Checked := not Center1.Checked;
  if Center1.Checked then
end;

procedure TFormMain.ViewStretch1Execute(Sender: TObject);
begin
  Stretch1.Checked := not Stretch1.Checked;
  if Stretch1.Checked then
    TImage32(PageControl1.ActivePage.Tag).ScaleMode := smStretch;
end;

procedure TFormMain.ViewResize1Execute(Sender: TObject);
begin
  Resize1.Checked := not Resize1.Checked;
  if Resize1.Checked then
    TImage32(PageControl1.ActivePage.Tag).ScaleMode := smResize;
end;

procedure TFormMain.ViewScale1Execute(Sender: TObject);
begin
  Scale1.Checked := not Scale1.Checked;
  if Scale1.Checked then
    TImage32(PageControl1.ActivePage.Tag).ScaleMode := smScale;
end;

procedure TFormMain.ViewNormal1Execute(Sender: TObject);
begin
  Normal1.Checked := not Normal1.Checked;
  if Normal1.Checked then
    TImage32(PageControl1.ActivePage.Tag).ScaleMode := smNormal;
end;

function TFormMain.ApplyCropSettings: TRect;
begin
  with TImage32(PageControl1.ActivePage.Tag) do
  begin
    Result.TopLeft := ControlToBitmap(Point
      (RBLayer.Location.TopLeft));