frmmain.pas

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

  dxBarManager1.SaveToIniFile(ChangeFileExt(Application.EXEName, '.INI'));
end;

procedure TFormMain.AddControls(Sender: TObject);
begin
  // Create a new tabsheet
  with PageControl1 do
    TabSheet := TTabSheet.Create(Self);
    // Set the tabsheet.pagecontrol to PageControl1
  TabSheet.PageControl := PageControl1;
  TabSheet.ShowHint := False;
    // Set the activepage to tabsheet
  PageControl1.ActivePage := TabSheet;
  with Tabsheet do begin
      // Create an image component
    Image := TImageENView.Create(Self);
    Image.Parent := Tabsheet;
    Image.Align := alClient;
    Image.Visible := True;
    Image.ShowHint := False;
    Image.ParentShowHint := True;
    Image.Scrollbars := ssBoth;
    Image.MouseInteract := [miSelect];
    Image.ZoomFilter := rfNone;
    Image.OnKeyDown := ImageEnViewKeyDown;
    Image.OnMouseDown := ImageEnViewMouseDown;
    Image.OnMouseMove := ImageEnViewMouseMove;
    Image.OnMouseUp := ImageEnViewMouseUp;
    Image.OnMouseInSel := ImageEnViewMouseInSel;
    Image.OnDblClick := ImageEnViewDblClick;
    Image.OnImageChange := ImageEnViewImageChange;
    Image.OnViewChange := ImageEnViewChange;
    Image.Cursor := 1785;
    Image.Tag := 0;
    Image.Scrollbars := ssBoth;
    Image.ZoomFilter := rfNone;
    Image.SelColor1 := clRed;
    Image.SelColor2 := clWhite;
    Image.BackgroundStyle := iebsChessboard;
    Image.BackGround := clWhite;
    Image.Visible := False;
    ImageEnIO1.AttachedImageEn := Image;
    ImageEnIO1.MsgLanguage := msEnglish;
    ImageEnProc1.AttachedImageEn := Image;
    ImageEnIO1.OnProgress := ImageEnViewProgress;
      // The folowing two lines are the key to referencing the components later
      // Set tag to monitor image change - 0 = false, 1 = true
    TabSheet.Tag := Integer(Image);
      // Set the caption of the tabsheet
    Caption := Format('Image%d', [PageControl1.ActivePage.PageIndex]);
    UpdateControls;
  end;
end;

procedure TFormMain.UpdateControls;
begin
  FileClose1.Enabled := PageControl1.PageCount <> 0;
  FileCloseAll1.Enabled := PageControl1.PageCount <> 0;
  FileSave1.Enabled := PageControl1.PageCount <> 0;
  FileSaveAs1.Enabled := PageControl1.PageCount <> 0;
  FileProperties1.Enabled := PageControl1.PageCount <> 0;
  OptionsMinimize1.Enabled := True;
  OptionsAutomatic1.Enabled := True;
  EditCopy1.Enabled := PageControl1.PageCount <> 0;
  Paste1.Enabled := (Clipboard.HasFormat(CF_PICTURE)) and (PageControl1.PageCount <> 0);
  EditPasteSelection1.Enabled := (Clipboard.HasFormat(CF_PICTURE)) and (PageControl1.PageCount <> 0);
  EditPaste1.Enabled := (Clipboard.HasFormat(CF_PICTURE)) and (PageControl1.PageCount <> 0);
  EditPasteNew1.Enabled := (Clipboard.HasFormat(CF_PICTURE));
  EditCrop1.Enabled := PageControl1.PageCount <> 0;
  EditCut1.Enabled := PageControl1.PageCount <> 0;
  EditUndo1.Enabled := PageControl1.PageCount <> 0;
  Flip1.Enabled := PageControl1.PageCount <> 0;
  ImageRot.Enabled := PageControl1.PageCount <> 0;
  Resize2.Enabled := PageControl1.PageCount <> 0;
  ImageEffects1.Enabled := PageControl1.PageCount <> 0;
  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;
  Print2.Enabled := PageControl1.PageCount <> 0;
  PrintPreview1.Enabled := PageControl1.PageCount <> 0;
  Flip1.Enabled := PageControl1.PageCount <> 0;
  ResizeImage1.Enabled := PageControl1.PageCount <> 0;
  SelectZoom1.Enabled := PageControl1.PageCount <> 0;
  SelectRect1.Enabled := PageControl1.PageCount <> 0;
  SelectCircle1.Enabled := PageControl1.PageCount <> 0;
  SelectPolygon1.Enabled := PageControl1.PageCount <> 0;
  SelectNone1.Enabled := PageControl1.PageCount <> 0;
  SelectWand1.Enabled := PageControl1.PageCount <> 0;
  dxBarButton7.Enabled := PageControl1.PageCount <> 0;
  dxBarSpinEdit1.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) and (TImageENView(PageControl1.ActivePage.Controls[0]).MouseInteract <> [miSelectPolygon]) 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;
    finally 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 ';
  finally
    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 := '';
   // 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;
      dxBarMRUListItem1.AddItem(fPathFilename, nil);
    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