frmmain.pas

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

  ImageRotate1.Enabled := PageControl1.PageCount <> 0;
  Adjust1.Enabled := PageControl1.PageCount <> 0;
  Colors1.Enabled := PageControl1.PageCount <> 0;
  ImageCalcColors11.Enabled := PageControl1.PageCount <> 0;
  ImageCalcColors1.Enabled := PageControl1.PageCount <> 0;
  Select1.Enabled := PageControl1.PageCount <> 0;
  View1.Enabled := PageControl1.PageCount <> 0;
  ImageGrayScale1.Enabled := PageControl1.PageCount <> 0;
  Image1.Enabled := PageControl1.PageCount <> 0;
  ImageBW1.Enabled := PageControl1.PageCount <> 0;
  Image16Color1.Enabled := PageControl1.PageCount <> 0;
  Image256Color1.Enabled := PageControl1.PageCount <> 0;
  ImageTrueColor1.Enabled := PageControl1.PageCount <> 0;
  ImageBrightness1.Enabled := PageControl1.PageCount <> 0;
  ImageResize1.Enabled := PageControl1.PageCount <> 0;
  ImageVertFlip1.Enabled := PageControl1.PageCount <> 0;
  ZoomCombo.Enabled := PageControl1.PageCount <> 0;
  ViewFullScreen1.Enabled := PageControl1.PageCount <> 0;
  Contrast1.Enabled := PageControl1.PageCount <> 0;
  ToggleSelect1.Enabled := PageControl1.PageCount <> 0;
  Print2.Enabled := PageControl1.PageCount <> 0;
  if PageControl1.PageCount = 0 then begin
    StatusBar1.Panels[1].Text := '         ';
    StatusBar1.Panels[2].Text := '         ';
    StatusBar1.Panels[3].Text := '         ';
    StatusBar1.Panels[4].Text := '         ';
  end
  else
  begin
    // 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 ';
    StatusBar1.Panels[4].Text := PixelFormatToColors(TImageENView(PageControl1.ActivePage.Tag
      ).Bitmap.PixelFormat);
  end;
end;

procedure TFormMain.ImageEnViewDblClick(Sender: TObject);
begin
  if PageControl1.PageCount <> 0 then
  begin
    FullScreen := TFullScreen.Create(Self);
    try
      Screen.Cursor := crDefault;
      // Copy image to fullscreen image
      FullScreen.ImageEnView1.Bitmap.Assign(TImageENView(PageControl1.ActivePage.Controls[0]).Bitmap);
      // Show the image fullscreen
      FullScreen.Showmodal;
      Screen.Cursor := crDefault;
    except FullScreen.Free; end;
  end;
end;

procedure TFormMain.EditUndo1Execute(Sender: TObject);
begin
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
 // Undo
  ImageEnProc1.Undo;
  // Update image & buttons
  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.Controls[0]).Refresh;
end;

procedure TFormMain.CaptureDesktop1Execute(Sender: TObject);
begin
   // Create new image
  AddControls(Sender);
  if PageControl1.PageCount <> 0 then
  begin
    // Set file information
    TImageEnView(PageControl1.ActivePage.Tag).Assign(ASGScreenCapture1.CaptureDesktop);
    TImageEnView(PageControl1.ActivePage.Controls[0]).Tag := 1;
    // 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 ';
    Tabsheet.ImageIndex := 0;
  end;
  TImageEnView(PageControl1.ActivePage.Tag).Visible := True;
end;

procedure TFormMain.CaptureArea1Execute(Sender: TObject);
begin
 // Create new image
  AddControls(Sender);
  if PageControl1.PageCount <> 0 then
  begin
    // Set file information
    fFilename := Format('Image %d', [PageControl1.ActivePage.PageIndex]) + '.bmp';
    if OpenImageEnDialog1.FileName = '' then
      fPathFilename := LowerCase(ExtractFilePath(fDefaultFolder) + fFilename)
    else
      fPathFilename := LowerCase(ExtractFilePath(OpenImageEnDialog1.FileName) + fFilename);
    // Capture area of screen
    TImageEnView(PageControl1.ActivePage.Tag).Assign(ASGScreenCapture1.CaptureSelection);
    TImageEnView(PageControl1.ActivePage.Controls[0]).Tag := 1;
      // 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 ';
    Tabsheet.ImageIndex := 2;
  end;
  TImageEnView(PageControl1.ActivePage.Tag).Visible := True;
end;

procedure TFormMain.CaptureActive1Execute(Sender: TObject);
begin
 // Create new image
  AddControls(Sender);
  if PageControl1.PageCount <> 0 then
  begin
    // Set file information
    TImageEnView(PageControl1.ActivePage.Tag).Assign(ASGScreenCapture1.CaptureActiveWindow);
    TImageEnView(PageControl1.ActivePage.Controls[0]).Tag := 1;
    // 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 ';
    Tabsheet.ImageIndex := 1;
  end;
  TImageEnView(PageControl1.ActivePage.Tag).Visible := True;
end;

procedure TFormMain.CaptureObject1Execute(Sender: TObject);
begin
 // Create new image
  AddControls(Sender);
  if PageControl1.PageCount <> 0 then
  begin
    // Copy the image to the Image component
    TImageEnView(PageControl1.ActivePage.Tag).Assign(ASGScreenCapture1.CaptureObject);
    TImageEnView(PageControl1.ActivePage.Controls[0]).Tag := 1;
      // 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 ';
  end; {If}
  Tabsheet.ImageIndex := 3;
  TImageEnView(PageControl1.ActivePage.Tag).Visible := True;
end;

procedure TFormMain.FileNew1Execute(Sender: TObject);
begin
  AddControls(Sender);
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
   // Set the caption of the tabsheet
  TabSheet.Caption := Format('Untitled%d', [PageControl1.ActivePage.PageIndex]);
  // Set tabsheet glyph
  Tabsheet.ImageIndex := 6;
  ImageEnProc1.ImageResize(640, 480);
  try
    ImageEnProc1.ClearUndo;
    // 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 ';
  except
    FileClose1Execute(Self);
    StatusBar1.Panels[1].Text := '   ';
  end;
end;

function GetcColorString(iBitsPerPixel: integer): string;
begin
  case iBitsPerPixel of
    1: result := '2';
    2: result := '4';
    3: result := '16';
    4: result := '8';
    5: result := '32';
    6: result := '64';
    7: result := '128';
    8: result := '256';
    16: result := '65,536';
    24: result := '16 Million';
    32: result := '32 Million';
  else result := 'Unknown';
  end;
end;

procedure TFormMain.ShowHint(Sender: TObject);
begin
  if Application.Hint <> '' then
    StatusBar1.Panels[0].Text := Application.Hint;
end;

procedure TFormMain.ShowIOParams(Params: TIOParamsVals);
var
  ss: string;
  fFileSize: double;
  BitsPerPixel: integer;
begin
  // Initalize string variable and filesize
  ss := '';
  fFileSize := 0;
  // Set image to active page
  ImageEnIO1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  with Params do begin
    fPathFilename := PageControl1.ActivePage.Caption;
    fFileSize := _getfilesize(fPathFilename);
    if fFilesize <> -1 then
      ss := Format('File size:%10.0g ', [fFileSize]) + ' bytes';
    StatusBar1.Panels[1].Text := ss;
    ss := 'ColorMapCount: ' + IntToStr(ColorMapCount) + ' ';
    StatusBar1.Panels[2].Text := ss;
    ss := 'BitsPerSample: ' + IntToStr(BitsPerSample) + ' ';
    StatusBar1.Panels[3].Text := ss;
    BitsPerPixel := BitsPerSample * SamplesPerPixel;
    ss := GetcColorString(BitsPerPixel) + ' colors';
    StatusBar1.Panels[4].Text := ss;
    ss := 'FileType: ' + FileTypeStr + ' ';
    StatusBar1.Panels[5].Text := ss;
  end;
end;

procedure TFormMain.FileOpen1Execute(Sender: TObject);
begin
  OpenImageEnDialog1.FileName := '';
  OpenImageEnDialog1.InitialDir := '';
  OpenImageEnDialog1.DefaultExt := 'bmp';
  // Open an image file
  if OpenImageEnDialog1.Execute then
  begin
    // Create new image
    AddControls(Sender);
    // Set filename and path
    fFilename := ExtractFilename(OpenImageEnDialog1.Filename);
    fPathFilename := OpenImageEnDialog1.FileName;
    // Set tabsheet caption
    TabSheet.Caption := fPathFilename;
    // Set tabsheet glyph
    Tabsheet.ImageIndex := 5;
    // If file exists then load it
    if FileExists(fPathFilename) then
    begin
      // Show progress bar
      ProgressBar1.Visible := True;
      // Load the file
      ImageEnIO1.LoadFromFile(fPathFilename);
      // Set progress bar position to 0 and hide it
      ProgressBar1.Position := 0;
      ProgressBar1.Visible := False;
      // Update menu & toolbar
      UpdateControls;
      ImageEnIO1.ParamsFromFile(fPathFilename);
      if ImageEnIO1.Params.FileType <> ioUnknown then
        ShowIOParams(ImageEnIO1.Params);
      // 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).Visible := True;
    end;
  end;
end;

procedure TFormMain.FileClose1Execute(Sender: TObject);
begin
  if PageControl1.PageCount <> 0 then 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
            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.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