frmmain.pas

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

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
  OptionsMinimize1.Checked := not OptionsMinimize1.Checked;
  ASGScreenCapture1.Minimize := OptionsMinimize1.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
  if assigned(Params) then begin
    with Params, PropertiesDlg do begin
      txtFilename.Caption := '';
      txtSize.Caption := '';
      txtColors.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) + ' pixels';
      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
      fFileSize := _getfilesize(fPathFilename);
      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 := '';
      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.SelectWand1Execute(Sender: TObject);
begin
// Select Magic wand
  SelectZoom1.Checked := False;
  SelectRect1.Checked := False;
  SelectCircle1.Checked := False;
  SelectPolygon1.Checked := False;
  SelectNone1.Checked := False;
  SelectWand1.Checked := True;
  TImageENView(PageControl1.ActivePage.Controls[0]).MouseInteract := [miSelectMagicWand];
  TImageENView(PageControl1.ActivePage.Controls[0]).Cursor := 1785;
end;

procedure TFormMain.SelectZoom1Execute(Sender: TObject);
begin
   // Zoom
  SelectZoom1.Checked := True;
  SelectRect1.Checked := False;
  SelectCircle1.Checked := False;
  SelectPolygon1.Checked := False;
  SelectNone1.Checked := False;
  SelectWand1.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;
  SelectCircle1.Checked := False;
  SelectPolygon1.Checked := False;
  SelectNone1.Checked := False;
  SelectWand1.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;
  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;
  SelectCircle1.Checked := True;
  SelectPolygon1.Checked := False;
  SelectNone1.Checked := False;
  SelectWand1.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;
  SelectCircle1.Checked := False;
  SelectPolygon1.Checked := True;
  SelectNone1.Checked := False;
  SelectWand1.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;
  SelectCircle1.Checked := False;
  SelectPolygon1.Checked := False;
  SelectNone1.Checked := True;
  SelectWand1.Checked := False;
  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]);
  // Save undo file
  ImageEnProc1.SaveUndo;
  // Show progressbar
  ProgressBar1.Visible := True;
  // Convert to 256 colors
  ImageEnProc1.ConvertTo(256);
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := False;
  StatusBar1.Panels[4].Text := PixelFormatToColors(TImageENView(PageControl1.ActivePage.Tag
    ).Bitmap.PixelFormat);
  TImageENView(PageControl1.ActivePage.Controls[0]).Refresh;
end;

procedure TFormMain.Image16Color1Execute(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 to 16 colors
  ImageEnProc1.ConvertTo(16);
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := False;
  StatusBar1.Panels[4].Text := PixelFormatToColors(TImageENView(PageControl1.ActivePage.Tag
    ).Bitmap.PixelFormat);
  TImageENView(PageControl1.ActivePage.Controls[0]).Refresh;
end;

procedure TFormMain.ImageBW1Execute(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;
  fConvBW := TfConvBW.Create(Self);
  try
  finally fConvBW.Free; end;
  // Show BW Dialog and process image
  with fConvBW do
    if ShowModal = mrOK then begin
      Application.ProcessMessages;
      case RadioGroup1.ItemIndex of
        0: begin // Threshold
            if SpeedButton1.Down then
              ImageEnProc1.ConvertToBWThreshold(-1)
            else
              ImageEnProc1.ConvertToBWThreshold(strtointdef(Edit1.Text, 0));
          end;
        1: begin // Ordered
            ImageEnProc1.ConvertToBWOrdered;
          end;
      end;
    end;
  fConvBW.Free;
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := False;
  StatusBar1.Panels[4].Text := 'Black & White';
end;

procedure TFormMain.ColorAdjust1Click(Sender: TObject);
begin
    // Set image to active page
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
   // Save undo file
  ImageEnProc1.SaveUndo;
  // Show progress bar
  ProgressBar1.Visible := True;
  // Show color adjust dialog
  ImageEnProc1.DoPreviews(ppeColorAdjust);
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := False;
end;

procedure TFormMain.ImageEffects1Execute(Sender: TObject);
begin
  ProgressBar1.Visible := True;
  // Set image to active page
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  // Save undo file
  ImageEnProc1.SaveUndo;
  // Show effects dialog
  if ImageEnProc1.DoPreviews(ppeEffects) = True then
  // Set progress bar
    ProgressBar1.Position := 0;
  ProgressBar1.Visible := False;
end;

procedure TFormMain.ImageBrightness1Execute(Sender: TObject);
begin
   // Set image to active page
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
   // Save undo file
  ImageEnProc1.SaveUndo;
  // Show progress bar
  ProgressBar1.Visible := True;
  // Show color adjust dialog
  ImageEnProc1.DoPreviews(ppeColorAdjust);
  // Set progress bar
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := False;
end;

procedure TFormMain.ImageCalcColors1Execute(Sender: TObject);
var
  nc: integer;
begin
  // Set image to active page
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  // Calc # colors and show it
  nc := ImageEnProc1.CalcImageNumColors;
  ShowMessage('The active image has ' + IntToStr(nc) + ' colors. ');
end;

procedure TFormMain.ImageRotate1Execute(Sender: TObject);
begin
   // Set image to active page
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  fRotate := TfRotate.Create(Self);
  try
  // Set image to active page
  ImageEnIO1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  fRotate.ImageEnView1.Assign(TImageENView(PageControl1.ActivePage.Controls[0]));
  ProgressBar1.Visible := True;
  // Show rotate dialog
  if fRotate.ShowModal = mrOK then
    ImageEnProc1.Rotate(fRotate.Updown1.Position, fRotate.Checkbox1.Checked);
  finally fRotate.Free; end;
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := False;
end;

procedure TFormMain.ImageResize1Execute(Sender: TObject);
var
  w, h: integer;
begin
  // Show progress bar
  ProgressBar1.Visible := True;
  // Set image to active page
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  // Save undo file
  ImageEnProc1.SaveUndo;
  // Create and show resize dialog