frmmain.pas

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

  // 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
  finally fRotate.Free; end;
  // 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);
  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
  fResize := TfResize.Create(Self);
  try
  // Setup resize dialog
    fResize.OrgWidth := TImageENView(PageControl1.ActivePage.Controls[0]).Bitmap.Width;
    fResize.OrgHeight := TImageENView(PageControl1.ActivePage.Controls[0]).Bitmap.Height;
    fResize.Caption := 'Canvas';
    fResize.Panel1.Caption := '  Canvas Size';
    fResize.Resize := True;
  // Copy images to resize dialog
    fResize.ImageEnView1.Assign(TImageENView(PageControl1.ActivePage.Controls[0]).Bitmap);
    fResize.ImageEnProc1.SaveUndo;
  // Shoe resize dialog
    if fResize.ShowModal = mrOK then
    begin
    // Setup and Show Status Form
      frmStatus.lblStatus.Caption := 'Resizing canvas...';
      frmStatus.Show;
      frmStatus.lblStatus.Update;
      w := StrToIntDef(fResize.Edit1.Text, 0);
      h := StrToIntDef(fResize.Edit2.Text, 0);
      if (w > 0) and (h > 0) then
        ImageEnProc1.ImageResize(w, h);
    // Reset progress bar, menu and statusbar
      ProgressBar1.Position := 0;
      ProgressBar1.Visible := False;
      frmStatus.Hide;
    // 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;
  finally fResize.Free; end;
end;

procedure TFormMain.ImageResample1Execute(Sender: TObject);
var
  w, h: integer;
begin
  // Set image to active page
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  // Save undo file
  ImageEnProc1.SaveUndo;
  // Create and show resize dialog
  fResize := TfResize.Create(Self);
  try
  // setup resize dialog
    fResize.OrgWidth := TImageENView(PageControl1.ActivePage.Controls[0]).Bitmap.Width;
    fResize.OrgHeight := TImageENView(PageControl1.ActivePage.Controls[0]).Bitmap.Height;
    fResize.Caption := 'Resize';
    fResize.Panel1.Caption := '  Resize (Resample) image';
    fResize.Resize := False;
    fResize.Resample := True;
  // Copy images to resize dialog
    fResize.ImageEnView1.Assign(TImageENView(PageControl1.ActivePage.Controls[0]).Bitmap);
    fResize.ImageEnProc1.SaveUndo;
  // Show progress bar
    ProgressBar1.Visible := True;
  // Show resize dialog
    if fResize.ShowModal = mrOK then
    begin
    // Setup and Show Status Form
      frmStatus.lblStatus.Caption := 'Resizing image...';
      frmStatus.Show;
      frmStatus.lblStatus.Update;
      w := StrToIntDef(fResize.Edit1.Text, 0);
      h := StrToIntDef(fResize.Edit2.Text, 0);
      if (w > 0) and (h > 0) then
        ImageEnProc1.Resample(w, h, TResampleFilter(fResize.ComboBox1.ItemIndex));
    // Copy resized image back to main form
      TImageENView(PageControl1.ActivePage.Controls[0]).Bitmap.Assign(fResize.ImageEnView1.Bitmap);
    // Reset progress bar, menu and status bar
      ProgressBar1.Position := 0;
      ProgressBar1.Visible := False;
      frmStatus.Hide;
    end
    else
    begin
    // Reset progress bar, menu and status bar
      ProgressBar1.Position := 0;
      ProgressBar1.Visible := False;
      frmStatus.Hide;
    end;
  // 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 fResize.Free; end;
end;

procedure TFormMain.ViewFullScreen1Execute(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;
    finally FullScreen.Free; end;
    Screen.Cursor := crDefault;
  end;
end;

procedure TFormMain.ImageVertFlip1Execute(Sender: TObject);
begin
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  // Save undo file
  ImageEnProc1.SaveUndo;
  // Set image to active page
  ImageEnIO1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  // Flip it
  ImageEnProc1.Flip(fdVertical);
end;

procedure TFormMain.ImageHorzFlip1Execute(Sender: TObject);
begin
  ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  // Save undo file
  ImageEnProc1.SaveUndo;
  // Set image to active page
  ImageEnIO1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  // Flip it
  ImageEnProc1.Flip(fdHorizontal);
end;

procedure TFormMain.ImageRotateRight1Execute(Sender: TObject);
begin
  // Save undo file
  ImageEnProc1.SaveUndo;
  // Set image to active page
  ImageEnIO1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  ProgressBar1.Visible := True;
  // Rotate the image, with antialiasing
  ImageEnProc1.Rotate(90, true);
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := False;
end;

procedure TFormMain.ImageRotateLeft1Execute(Sender: TObject);
begin
  // Save undo file
  ImageEnProc1.SaveUndo;
  // Set image to active page
  ImageEnIO1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
  ProgressBar1.Visible := True;
  // Eotate the image, with antialiasing
  ImageEnProc1.Rotate(-90, true);
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := False;
end;

{================================== DrawImage =================================}
// DrawImage strechdraws an image on a canvas
// Since strechdraw spoils the colors we use StretchDIBits
{==============================================================================}

procedure DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap);
var
  Header, Bits: Pointer;
  HeaderSize: DWORD; //Integer;
  BitsSize: DWORD; //Longint;
begin
  GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
  Header := AllocMem(HeaderSize);
  Bits := AllocMem(BitsSize);
  try
    GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
    StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top,
      DestRect.Right - DestRect.Left, DestRect.Bottom - DestRect.Top,
      0, 0, ABitmap.Width, ABitmap.Height, Bits, TBitmapInfo(Header^),
      DIB_RGB_COLORS, SRCCOPY);
    { You might want to try DIB_PAL_COLORS instead, but this is well
      beyond the scope of my knowledge. }
  finally
    FreeMem(Header, HeaderSize);
    FreeMem(Bits, BitsSize);
  end;
end;

procedure TFormMain.PrintSetup1Execute(Sender: TObject);
begin
  PrinterSetupDialog1.Execute;
end;

procedure TFormMain.Print1Execute(Sender: TObject);
begin
  with Printer do
  begin
    BeginDoc;
    //Here we draw the image on the printercanvas, scaled up by a factor 2
    DrawImage(Canvas, Rect(0, 0, 2 * TImageENView(PageControl1.ActivePage.Controls[0]
      ).Bitmap.Width,
      2 * TImageENView(PageControl1.ActivePage.Controls[0]).Bitmap.Height),
      TImageENView(PageControl1.ActivePage.Controls[0]).Bitmap);
    EndDoc;
  end;
end;

procedure TFormMain.EditPasteSelection1Execute(Sender: TObject);
begin
  if Clipboard.HasFormat(CF_PICTURE) then
  begin
    // Set image to active page
    ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
    // Paste from clipboard
    ImageEnProc1.SelPasteFromClipStretch;
  end
  else
    MessageDlg('There is no image in the Clipboard.', mtInformation, [mbOK], 0);
end;

procedure TFormMain.EditPasteNew1Execute(Sender: TObject);
begin
  if PageControl1.PageCount <> 0 then
    // Save Undo file
    ImageEnProc1.SaveUndo;
  if Clipboard.HasFormat(CF_PICTURE) then begin
    // Create new image
    AddControls(Sender);
   // 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.FileProperties1Execute(Sender: TObject);
begin
  with PropertiesDlg do begin
    if FileExists(fPathFilename) then begin
      // set image to active page
      ImageEnIO1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
      ImageEnProc1.AttachedImageEn := TImageENView(PageControl1.ActivePage.Controls[0]);
      ImageEn1.Assign(TImageENView(PageControl1.ActivePage.Controls[0]).Bitmap);
      ShowPropertyIOParams(ImageEnIO1.Params);
      ShowModal;
    end
    else
      ShowMessage('Image must be opened from disk to enable properties dialog');
  end;
end;

procedure TFormMain.ZoomComboChange(Sender: TObject);
begin
  if ZoomCombo.Text = 'FIT' then
    TImageENView(PageControl1.ActivePage.Controls[0]).Fit else
   // show zoom change
    TImageENView(PageControl1.ActivePage.Controls[0]).Zoom := StrToInt(ZoomCombo.Text);
end;

procedure TFormMain.ImageEnViewImageChange(Sender: TObject);
begin
  ZoomCombo.Text := IntToStr(TImageENView(PageControl1.ActivePage.Controls[0]).Zoom);
end;

procedure TFormMain.ImageEnViewChange(Sender: TObject;
  Change: Integer);
begin
  ZoomCombo.Text := IntToStr(TImageENView(PageControl1.ActivePage.Controls[0]).Zoom);
end;

end.