frmmain.pas

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

            PageControl1.SelectNextPage(False);
            UpdateControls;
          end;
        mrCancel: Abort;
      end;
    end
    else
    begin
      TImageEnView(PageControl1.ActivePage.Tag).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 TImageEnView(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];
            TImageEnView(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
      TImageEnView(PageControl1.ActivePage.Tag).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
  ex: string;
  save: boolean;
begin
  ProgressBar1.Visible := True;
   // Set image to active page
  ImageEnIO1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  if fSaveAs then begin
     // Set filename
    fFilename := SaveImageEnDialog1.FileName;
    fPathFilename := SaveImageEnDialog1.FileName;
  end
  else begin
    fFilename := Format('Image %d', [PageControl1.ActivePage.PageIndex]) + '.bmp';
    fPathFilename := ExtractFilePath(LowerCase(Application.ExeName)) + fFilename;
  end;
   // Get file type from image file
  ex := Lowercase(ExtractFileExt(fPathFilename));
  if (ex = '.gif') then begin
    if ImageEnIO1.DoPreviews([ppGIF]) then begin
      ImageEnIO1.SaveToFileGif(fPathFilename);
    end;
  end else
    with ImageEnIO1 do begin
      Save := False;
      if (ex = '.jpg') or (ex = '.jpeg') then
        save := DoPreviews([ppJPEG]);
      if (ex = '.tif') then
        save := DoPreviews([ppTIFF]);
      if (ex = '.bmp') then
        save := DoPreviews([ppBMP]);
      if (ex = '.gif') then
        save := DoPreviews([ppGIF]);
      if (ex = '.pcx') then
        save := DoPreviews([ppPCX]);
      if (ex = '.png') then
        save := DoPreviews([ppPNG]);
      if (ex = '.wmf') then begin
        ShowMessage('Can not save to WMF file format.');
        save := False;
      end;
      if (ex = '.emf') then begin
        ShowMessage('Can not save to EMF file format.');
        save := False;
      end;
      if (ex = '.ico') then begin
        ShowMessage('Can not save to Icon file format.');
        save := False;
      end;
      if (ex = '.cur') then begin
        ShowMessage('Can not save to Cursor file format.');
        save := False;
      end;
      if save then begin
            // Save image tp file
        SaveToFile(fPathFilename);
            // Set tabsheet caption
        PageControl1.ActivePage.Caption := fPathFilename;
            // Set statusbar
        Statusbar1.Panels[0].Text := ' ' + ExtractFilename(fPathFilename) + ' ';
        UpdateControls;
            // Change tag to show image not changed
        TImageENView(PageControl1.ActivePage.Controls[0]).Tag := 0;
      end
      else
            // Change tag to show image changed
        TImageENView(PageControl1.ActivePage.Controls[0]).Tag := 1;
    end;
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := False;
end;

procedure TFormMain.FileSaveAs1Execute(Sender: TObject);
begin
   // Set image to active page
  ImageEnIO1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  SaveImageEnDialog1.FileName := '';
  SaveImageEnDialog1.DefaultExt := fDefaultExtension;
  fDefaultFolder := ExtractFilePath(Application.EXEName);
  SaveImageEnDialog1.InitialDir := fDefaultFolder;
  // launch save image dialog
  if SaveImageEnDialog1.Execute then
  begin
    fSaveAs := True;
    // Set filename
    fFilename := SaveImageEnDialog1.FileName;
    fPathFilename := SaveImageEnDialog1.FileName;
    // Set tabsheet caption
    PageControl1.ActivePage.Caption := ExtractFilename(fPathFilename);
    // Execute filesave
    FileSave1Execute(Self);
  end;
end;

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

procedure TFormMain.EditCopy1Execute(Sender: TObject);
begin
  // Set image to active page
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  if TImageENView(PageControl1.ActivePage.Controls[0]).VisibleSelection then
      // Copy selection to clipboard
    ImageEnProc1.SelCopyToClip
  else
    ImageEnProc1.CopyToClipboard;
  UpdateControls;
end;

procedure TFormMain.EditPaste1Execute(Sender: TObject);
begin
  if Clipboard.HasFormat(CF_PICTURE) then
  begin
      // Set image to active page
    ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
      // Save Undo file
    ImageEnProc1.SaveUndo;
      // Paste
    ImageEnProc1.PasteFromClipboard;
    Tabsheet.ImageIndex := 6;
      // Show image has been changed
    TImageENView(PageControl1.ActivePage.Controls[0]).Tag := 1;
  end
  else
    MessageDlg('There is no image in the Clipboard.', mtInformation, [mbOK], 0);
end;

procedure TFormMain.EditCrop1Execute(Sender: TObject);
var
  ABitmap: TBitmap;
begin
  if TImageENView(PageControl1.ActivePage.Controls[0]).Selected then
  begin
    ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
    // Save undo file
    ImageEnProc1.SaveUndo;
    // Create a temp bitmap
    ABitmap := TBitmap.Create;
    try
    // Assign selection (crop) to Abitmap
      TImageENView(PageControl1.ActivePage.Controls[0]).AssignSelTo(ABitmap);
    // Copy the bitmap back to the Image component
      TImageENView(PageControl1.ActivePage.Controls[0]).Assign(ABitmap);
    // Change tag to show image changed
      TImageENView(PageControl1.ActivePage.Controls[0]).Tag := 1;
      TImageENView(PageControl1.ActivePage.Controls[0]).Update;
    finally ABitmap.Free; end;
  // Update controls
    UpdateControls;
    // Show image dimensions
    StatusBar1.Panels[1].Text := ' Height: ' +
      IntToStr(TImageENView(PageControl1.ActivePage.Tag).Bitmap.Height) + ' pixels' +
      '  Width: ' + IntToStr(TImageENView(PageControl1.ActivePage.Tag).Bitmap.Width) +
      ' pixels ';
    TImageENView(PageControl1.ActivePage.Tag).Invalidate;
  end
  else
    ShowMessage('Please select an area of the image to crop');
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 TImageEnView(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: Canclose := True;
          mrCancel: Abort;
        end;
      end;
      TImageEnView(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.ImageEnViewMouseInSel(Sender: TObject);
begin
  fInSelection := True;
end;

procedure TFormMain.ImageEnViewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   // ESC Key
  if (Key = VK_Escape) then begin
    ZoomCombo.Text := '100';
    TImageENView(PageControl1.ActivePage.Controls[0]).Zoom := 100;
      // Remove Selection
    TImageENView(PageControl1.ActivePage.Controls[0]).Deselect;
  end;
end;

procedure TFormMain.ImageEnViewMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  P1: TPoint;
begin
  TImageENView(PageControl1.ActivePage.Controls[0]).SetFocus;
  StatusBar1.Panels[2].Text := '          ';
  StatusBar1.Panels[3].Text := '          ';
  if (not fInSelection) and (TImageENView(PageControl1.ActivePage.Controls[0]).MouseInteract = [
    miSelect]) or (TImageENView(PageControl1.ActivePage.Controls[0]).MouseInteract = [
    miSelectCircle]) then begin
    TImageENView(PageControl1.ActivePage.Controls[0]).VisibleSelection := False;
    TImageENView(PageControl1.ActivePage.Controls[0]).DeSelect;
  end
  else
  begin
    TImageENView(PageControl1.ActivePage.Controls[0]).VisibleSelection := True;
  end;
  // if not in zoom mode then popupmenu
  if TImageENView(PageControl1.ActivePage.Controls[0]).MouseInteract <> [miZoom, miScroll] then
    if Button = mbRight then
    begin
     // get cursor position
      GetCursorPos(P1);
      MainPopupMenu.Popup(P1.x, P1.y);
    end;
end;

procedure TFormMain.ImageEnViewMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  SLeft: integer;
  STop: integer;
  SRight: integer;
  SBottom: integer;
  SHeight: integer;
  SWidth: integer;
begin
  // Show mouse move coords
  StatusBar1.Panels[2].Width := 100;
  StatusBar1.Panels[3].Width := 100;
  StatusBar1.Panels[2].Text := ' Horz: ' + IntToStr(X) + ' pixels ';
  StatusBar1.Panels[3].Text := ' Vert: ' + IntToStr(Y) + ' pixels ';
  if (TImageENView(PageControl1.ActivePage.Controls[0]).Selected) and (fInSelection) then
  begin
    SLeft := TImageENView(PageControl1.ActivePage.Controls[0]).SelX1;
    STop := TImageENView(PageControl1.ActivePage.Controls[0]).SelY1;
    SRight := TImageENView(PageControl1.ActivePage.Controls[0]).SelX2;
    SBottom := TImageENView(PageControl1.ActivePage.Controls[0]).SelY2;
    SHeight := SBottom - STop;
    SWidth := SRight - SLeft;
    if (SHeight > 0) and (SWidth > 0) and (fInSelection) then begin
      // Selected area
      StatusBar1.Panels[2].Width := 160;
      StatusBar1.Panels[3].Width := 100;
      StatusBar1.Panels[2].Text := 'Selected: ' +
        IntToStr(SHeight) + ' x ' +
        IntToStr(SWidth) + ' pixels ';
      StatusBar1.Panels[3].Text := ''
    end;
  end;
  fInSelection := False;
end;

procedure TFormMain.ImageEnViewMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  fInSelection := False;
  StatusBar1.Panels[3].Text := '          ';
end;

procedure TFormMain.ImageEnViewProgress(Sender: TObject; per: Integer);
begin
  // Show progressbar position
  ProgressBar1.Position := per;
end;

procedure TFormMain.EditCut1Execute(Sender: TObject);
begin
  // Set image to active page
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  // Save undo file
  ImageEnProc1.SaveUndo;
  // Cut selection to clipboard
  ImageEnProc1.SelCutToClip;
  UpdateControls;
end;

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

procedure TFormMain.OptionsDelay1Execute(Sender: TObject);