frmmain.pas

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

  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;
  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);
        // 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
    TImageENView(PageControl1.ActivePage.Controls[0]).Zoom := StrToInt(ZoomCombo.Text);
  TImageENView(PageControl1.ActivePage.Controls[0]).SetFocus;
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;

procedure TFormMain.PrintPreview1Execute(Sender: TObject);
begin
  Screen.Cursor := crHourglass;
  ReportSystem1.Execute;
  Screen.Cursor := crDefault;
end;

procedure TFormMain.dxBarMRUListItem1Click(Sender: TObject);
var
  fFileName: string;
begin
  // Create new image
  AddControls(Sender);
  // Set filename and path
  FFileName := dxBarMRUListItem1.Items[dxBarMRUListItem1.ItemIndex];
  fPathFilename := dxBarMRUListItem1.Items[dxBarMRUListItem1.ItemIndex];
  // 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;

procedure TFormMain.ReportSystem1Print(Sender: TObject);
begin
  Screen.Cursor := crHourglass;
  try
    // Copy bitmap to report
    with Sender as TBaseReport do begin
      PrintBitmapScaled(Sender as TBaseReport,1.0,1.0,6.0,0.0,TImageENView(PageControl1.ActivePage.Tag).Bitmap);
      end;
  finally Screen.Cursor := crDefault; end;
end;

procedure TFormMain.dxBarButton1Click(Sender: TObject);
begin
  dxBarButton1.Down := not dxBarButton1.Down;
  dxBarManager1.Style := bmsEnhanced;
end;

procedure TFormMain.dxBarButton2Click(Sender: TObject);
begin
  dxBarButton2.Down := not dxBarButton2.Down;
  dxBarManager1.Style := bmsFlat
end;

procedure TFormMain.dxBarButton3Click(Sender: TObject);
begin
  dxBarButton3.Down := not dxBarButton3.Down;
  dxBarManager1.Style := bmsStandard;
end;

procedure TFormMain.dxBarButton4Click(Sender: TObject);
begin
  dxBarManager1.Customizing(True);
end;

procedure TFormMain.LMDGlobalHotKey1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
  VK_F7: CaptureDesktop1Execute(Sender);
  VK_F8: CaptureArea1Execute(Sender);
  VK_F9: CaptureActive1Execute(Sender);
  VK_F10: CaptureObject1Execute(Sender);
  end; // case
end;

procedure TFormMain.Desktop2Click(Sender: TObject);
begin
CaptureDesktop1Execute(Sender);
end;

procedure T