frmmain.pas

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

    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]).Refresh;
    finally ABitmap.Free; end;
  // indicate that file has been changed
    TImageENView(PageControl1.ActivePage.Controls[0]).Tag := 1;
  // 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.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]) 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);
      PopupMenu1.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;
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.OptionsMinimize1Execute(Sender: TObject);
begin
  Minimize1.Checked := not Minimize1.Checked;
  ASGScreenCapture1.Minimize := Minimize1.Checked;
end;

procedure TFormMain.ShowPropertyIOParams(params: TIOParamsVals);
var
  ss: string;
  mdim, bitcount: integer;
  fFileSize: integer; // dim. ultimo file caricato
  fFrames: integer; // nr. frames ultimo file caricato
begin
  fFileSize := 0;
  if assigned(Params) then begin
    with Params, PropertiesDlg do begin
      txtFilename.Caption := '';
      txtSize.Caption := '';
      txtColors.Caption := '';
      txtFilesize.Caption := '';
      txtMem.Caption := '';
      txtFileType.Caption := '';
      txtDPI.Caption := '';
      txtDPIY.Caption := '';
      txtColorMapCount.Caption := '';
      ss := ExtractFilename(fPathFilename);
      txtFilename.Caption := ss;
         // Width X Height Pixel (frames)
      ss := IntToStr(Params.Width) + ' x ' + IntToStr(Params.Height) + ' pixel';
      txtSize.Caption := ss;
         // dpi
      ss := inttostr(DpiX) + ' x ' + inttostr(DpiY) + ' dpi';
      txtDPI.Caption := ss;
         // xxx colors
      if (SamplesPerPixel = 4) and (BitsPerSample = 8) then
        ss := ' 16 million colors '
      else
        ss := IntToStr(1 shl (SamplesPerPixel * BitsPerSample));
      ss := ss + ' ' + iemsg(IEMSG_COLORS, fMsgLanguage) + ' (';
      ss := ss + IntToStr(SamplesPerPixel * BitsPerSample) + ' bit)';
      txtColors.caption := ss;
         // file size
      if fFileSize < 1024 then
        ss := 'File: ' + inttostr(fFileSize) + ' bytes'
      else
        ss := 'File: ' + inttostr(fFileSize div 1024) + ' Kb';
      txtFileSize.Caption := ss;
         // memory size
         // solo pf1bit e pf24bit sono attualmente supportati
      if (SamplesPerPixel = 1) and (BitsPerSample = 1) then
        bitcount := 1
      else
        bitcount := 24;
      fFrames := 1;
      mdim := (((Width * BitCount) + 31) div 32) * 4 * height * fFrames;
      if mdim < 1024 then
        ss := ss + '   Mem: ' + inttostr(mdim) + ' bytes'
      else
        ss := ss + '   Mem: ' + inttostr(mdim div 1024) + ' Kb';
         //
      txtMem.Caption := ss;
         // compression
      ss := FileTypeStr;
      txtFileType.Caption := ss;
    end;
  end else begin
    with PropertiesDlg do begin
      txtFilename.Caption := '';
      txtSize.Caption := '';
      txtColors.Caption := '';
      txtFilesize.Caption := '';
      txtMem.Caption := '';
      txtFileType.Caption := '';
      txtDPI.Caption := '';
      txtDPIY.Caption := '';
      txtColorMapCount.Caption := '';
    end;
  end;
end;

procedure TFormMain.PageControl1Change(Sender: TObject);
begin
  if not TImageENView(PageControl1.ActivePage.Tag).Bitmap.Empty then
  begin
    fPathFilename := PageControl1.ActivePage.Caption;
   // Set image to active page
    ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
    UpdateControls;
  end;
end;

procedure TFormMain.SelectZoom1Execute(Sender: TObject);
begin
   // Zoom
  SelectZoom1.Checked := True;
  SelectRect1.Checked := False;
  SelectMove1.Checked := False;
  SelectCircle1.Checked := False;
  SelectPolygon1.Checked := False;
  SelectNone1.Checked := False;
  TImageENView(PageControl1.ActivePage.Controls[0]).MouseInteract := [miZoom, miScroll];
  TImageENView(PageControl1.ActivePage.Controls[0]).Cursor := 1779;
end;

procedure TFormMain.SelectRect1Execute(Sender: TObject);
begin
   // Select rect
  SelectZoom1.Checked := False;
  SelectRect1.Checked := True;
  SelectMove1.Checked := False;
  SelectCircle1.Checked := False;
  SelectPolygon1.Checked := False;
  SelectNone1.Checked := False;
  TImageENView(PageControl1.ActivePage.Controls[0]).MouseInteract := [miSelect];
  TImageENView(PageControl1.ActivePage.Controls[0]).Cursor := 1785;
end;

procedure TFormMain.SelectMove1Execute(Sender: TObject);
begin
    // Hand
  SelectZoom1.Checked := False;
  SelectRect1.Checked := False;
  SelectMove1.Checked := True;
  SelectCircle1.Checked := False;
  SelectPolygon1.Checked := False;
  SelectNone1.Checked := False;
  TImageENView(PageControl1.ActivePage.Controls[0]).MouseInteract := [miScroll];
  TImageENView(PageControl1.ActivePage.Controls[0]).Cursor := 1782;
end;

procedure TFormMain.SelectCircle1Execute(Sender: TObject);
begin
   // Select circle
  SelectZoom1.Checked := False;
  SelectRect1.Checked := False;
  SelectMove1.Checked := False;
  SelectCircle1.Checked := True;
  SelectPolygon1.Checked := False;
  SelectNone1.Checked := False;
  TImageENView(PageControl1.ActivePage.Controls[0]).MouseInteract := [miSelectCircle];
  TImageENView(PageControl1.ActivePage.Controls[0]).Cursor := 1785;
end;

procedure TFormMain.SelectPolygon1Execute(Sender: TObject);
begin
  // Select polygon
  SelectZoom1.Checked := False;
  SelectRect1.Checked := False;
  SelectMove1.Checked := False;
  SelectCircle1.Checked := False;
  SelectPolygon1.Checked := True;
  SelectNone1.Checked := False;
  TImageENView(PageControl1.ActivePage.Controls[0]).MouseInteract := [miSelectPolygon];
  TImageENView(PageControl1.ActivePage.Controls[0]).Cursor := 1785;
end;

procedure TFormMain.SelectNone1Execute(Sender: TObject);
begin
  SelectZoom1.Checked := False;
  SelectRect1.Checked := False;
  SelectMove1.Checked := False;
  SelectCircle1.Checked := False;
  SelectPolygon1.Checked := False;
  SelectNone1.Checked := True;
  TImageENView(PageControl1.ActivePage.Controls[0]).MouseInteract := [miScroll];
  TImageENView(PageControl1.ActivePage.Controls[0]).Cursor := 1782;
  TImageENView(PageControl1.ActivePage.Controls[0]).VisibleSelection := False;
  TImageENView(PageControl1.ActivePage.Controls[0]).DeSelect;
end;

procedure TFormMain.ImageGrayScale1Execute(Sender: TObject);
begin
   // Set image to active page
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  // Save undo file
  ImageEnProc1.SaveUndo;
  ProgressBar1.Visible := True;
  // Process image
  ImageEnProc1.ConvertToGray;
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := False;
  StatusBar1.Panels[4].Text := 'Grayscale ' + PixelFormatToColors(TImageENView(
    PageControl1.ActivePage.Tag).Bitmap.PixelFormat);
end;

procedure TFormMain.ImageTrueColor1Execute(Sender: TObject);
begin
   // set image to active page
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  // Save undo file
  ImageEnProc1.SaveUndo;
  // Show progressbar
  ProgressBar1.Visible := True;
  // Convert image
  ImageEnProc1.ConvertTo24Bit;
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := False;
  StatusBar1.Panels[4].Text := PixelFormatToColors(TImageENView(PageControl1.ActivePage.Tag
    ).Bitmap.PixelFormat);
end;

procedure TFormMain.Image256Color1Execute(Sender: TObject);
begin
   // Set image to active page
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);