frmmain.pas

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

end;

procedure TFormMain.FileOpen1Execute(Sender: TObject);
begin
  // Set the initial directory of the OpenPictureDialog
  OpenPictureDialog1.InitialDir := DefaultDirectory;
  OpenPictureDialog1.DefaultExt := GraphicExtension ( TBitmap );
  if OpenPictureDialog1.Execute then
  begin
    Screen.Cursor := crHourglass;
    ProgressBar1.Visible := True;
    // Add ScrollBox and Image Controls to a new tabsheet
    AddControls ( Sender );
    if PageControl1.PageCount <> 0 then
    begin
      try
        TImage ( PageControl1.ActivePage.Tag ).Picture.LoadFromFile ( OpenPictureDialog1.Filename );
        TImage ( PageControl1.ActivePage.Tag ).Tag := 0;
      except
        Screen.Cursor := crDefault;
        ShowMessage ( 'Error loading image' );
      end;
      if TImage ( PageControl1.ActivePage.Tag ).Picture.Graphic.Empty then exit;
      TabSheet.Caption := ExtractFileName ( OpenPictureDialog1.Filename );
         // set tabsheet glyph
      Tabsheet.ImageIndex := 5;
      ScrollBox := TScrollbox ( PageControl1.ActivePage.Controls[ 0 ] );
      with ScrollBox do
      begin
        HorzScrollBar.Range := TImage ( PageControl1.ActivePage.Tag ).Picture.Width;
        VertScrollBar.Range := TImage ( PageControl1.ActivePage.Tag ).Picture.Height;
      end;
    end;
    TImage ( PageControl1.ActivePage.Tag ).Refresh;
    TImage ( PageControl1.ActivePage.Tag ).Hint := 'Height: ' + IntToStr ( TImage ( PageControl1.ActivePage.Tag ).Picture.Height ) +
      ' pixels' + '  Width: ' + IntToStr ( TImage ( PageControl1.ActivePage.Tag ).Picture.Width ) +
      ' pixels';
  end;
  ProgressBar1.Visible := False;
  TImage(PageControl1.ActivePage.Tag).Width := Max(1, Round(TImage(PageControl1.ActivePage.Tag).Picture.Width * TrackBar1.Position / 100));
  TImage(PageControl1.ActivePage.Tag).Height := Max(1, Round(TImage(PageControl1.ActivePage.Tag).Picture.Height * TrackBar1.Position / 100));
  Screen.Cursor := crDefault;
end;

procedure TFormMain.FileClose1Execute(Sender: TObject);
begin
  if PageControl1.PageCount <> 0 then 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: begin
            TImage(PageControl1.ActivePage.Tag).Destroy;
            TScrollbox(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
      TImage(PageControl1.ActivePage.Tag).Destroy;
      TScrollbox(PageControl1.ActivePage.Controls[0]).Destroy;
          // Close the active page
      PageControl1.ActivePage.Free; // Closes and Frees the ActivePage
      PageControl1.SelectNextPage(False);
      UpdateControls;
    end;
    if PageControl1.PageCount = 0 then
      ClearStatusBar;
  end;
end;

procedure TFormMain.FileCloseAll1Execute(Sender: TObject);
var
  i: Integer;
begin
   //Close All pages
  for i := PageControl1.PageCount - 1 downto 0 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: begin
            PageControl1.ActivePage := PageControl1.Pages[i];
            TImage(PageControl1.ActivePage.Tag).Destroy;
            TScrollbox(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
      TImage(PageControl1.ActivePage.Tag).Destroy;
      TScrollbox(PageControl1.ActivePage.Controls[0]).Destroy;
        // Close the active page
      PageControl1.ActivePage.Free; // Closes and Frees the ActivePage
      PageControl1.SelectNextPage(False);
      UpdateControls;
    end;
    if PageControl1.PageCount = 0 then
      ClearStatusBar;
  end;
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;
      try
      if length(FileExtension) = 0 then
        FileExtension := '.bmp';
      if length(FileName) = 0 then
        FileName := 'Untitled' + CaptureStr;
      if length(Folder) = 0 then
        Folder := DefaultDirectory + '\';
      FNE := FileName + FileExtension;
      FilePathName := Folder + FileName + FileExtension;
         // 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
        TImage(PageControl1.ActivePage.Tag).Picture.SaveToFile(FilePathName);
      except
        on EInvalidGraphic do
          MessageDlg('Error saving file,' + FilePathName, mtWarning, [mbOK], 0);
      end;
         // Reload the file to show compression
      try
        TImage(PageControl1.ActivePage.Tag).Picture.LoadFromFile(FilePathName);
      except
        on EInvalidGraphic do
          TImage(PageControl1.ActivePage.Tag).Picture.Graphic := nil;
      end;
      PageControl1.ActivePage.Caption := ExtractFilename(FilePathName);
      finally Screen.Cursor := crDefault; end;
    end;
  end;
end;

procedure TFormMain.FileSaveAs1Execute(Sender: TObject);
var
  Temp: Boolean;
  jp: TJpegImage;
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.DefaultExt := GraphicExtension(TBitmap);
    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';
      Temp := TImage(PageControl1.ActivePage.Tag).Picture.Graphic is TJPEGImage;
      if not (Temp) and (FileExtension = '.jpg') then begin
        with TJPEGImage(TImage(PageControl1.ActivePage.Tag).Picture.Graphic) do
          JPEGNeeded;
        jp := TJpegImage.Create;
        jp.PixelFormat := jf24Bit;
        try
          with jp do
            begin
              Assign(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap);
                SaveToFile(SavePictureDialog1.Filename)
            end;
        finally jp.Free; end;
      end
      else
      // Save image to file
      try
        TImage(PageControl1.ActivePage.Tag).Picture.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;

      PageControl1.ActivePage.Caption := ExtractFilename(SavePictureDialog1.Filename);
    end;
  end;
  TImage(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;
    // if Rubberband is visible then copy selection... else copy image
    if RubberbandVisible then
       // Copy Selection to clipboard
      CopySelectionToClipboard
    else
       // Copy image to clipboard
      Clipboard.Assign(TImage(PageControl1.ActivePage.Tag).Picture);
    UpdateControls;
    Screen.Cursor := crDefault;
  end;
end;

procedure TFormMain.EditPaste1Execute(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  if Clipboard.HasFormat(CF_BITMAP) 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 }
      TImage(PageControl1.ActivePage.Tag).Canvas.Draw(0, 0, Bitmap); { copy the bitmap to the Image }
      TImage(PageControl1.ActivePage.Tag).Tag := 1;
    finally
      Bitmap.Free;
    end;
  end;
end;

procedure TFormMain.EditCrop1Execute(Sender: TObject);
var
  bitmap: TBitmap;
  sourcerect: TRect;
  destrect: TRect;
  StretchFactor_X: Integer;
  StretchFactor_Y: Integer;
begin
  if (PageControl1.PageCount <> 0) and (PointEnd.X > PointStart.X) and (PointEnd.Y > PointStart.Y) then
  begin
     // Erase the the rubberband created with PImage1MouseMove
    DrawRubberband;
    begin
      // If image present...
      if Assigned(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap) then
      begin
        TMPBmp.Assign(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap);
        Bitmap := TBitmap.Create;
        if Image.Stretch then
        begin
          StretchFactor_X := Round(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.Width / TImage(
            PageControl1.ActivePage.Tag).Picture.Bitmap.Width);
          StretchFactor_Y := Round(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.Height / TImage(
            PageControl1.ActivePage.Tag).Picture.Bitmap.Height);
          Bitmap.Width := (PointEnd.X * StretchFactor_X) - (PointStart.X * StretchFactor_X);
          Bitmap.Height := (PointEnd.Y * StretchFactor_Y) - (PointStart.Y * StretchFactor_Y);
          SourceRect.Left := PointStart.X * StretchFactor_X;
          SourceRect.Top := PointStart.Y * StretchFactor_Y;
          SourceRect.Right := PointEnd.X * StretchFactor_X;
          SourceRect.Bottom := PointEnd.Y * StretchFactor_Y;
          DestRect.Left := 0;
          DestRect.Top := 0;
          DestRect.Right := (PointEnd.X * StretchFactor_X) - (PointStart.X * StretchFactor_X);
          DestRect.Bottom := (PointEnd.Y * StretchFactor_Y) - (PointStart.Y * StretchFactor_Y);
        end else
        begin
          Bitmap.Width := PointEnd.X - PointStart.X;
          Bitmap.Height := PointEnd.Y - PointStart.Y;
          SourceRect.Left := PointStart.X;
          SourceRect.Top := PointStart.Y;
          SourceRect.Right := PointEnd.X;
          SourceRect.Bottom := PointEnd.Y;
          DestRect.Left := 0;
          DestRect.Top := 0;
          DestRect.Right := PointEnd.X - PointStart.X;
          DestRect.Bottom := PointEnd.Y - PointStart.Y;
        end;
        SetStretchBltmode(Bitmap.Canvas.Handle, Stretch_deletescans);
        Bitmap.Canvas.CopyRect(DestRect, TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.Canvas,
          SourceRect);
        AddControls(Sender);
        Bitmap.Palette := TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.Palette;
        StatusBar1.Panels[1].Text := 'Height: ' + IntToStr(Bitmap.Height) +
          ' pixels Width: ' + IntToStr(Bitmap.Width) + ' pixels';
        TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.Width := Bitmap.Width;
        TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.Height := Bitmap.Height;
        TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.Assign(Bitmap);
        ScrollBox := TScrollbox(PageControl1.ActivePage.Controls[0]);
        with ScrollBox do
        begin