frmmain.pas

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

    if TImageScrollBox(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
            TImageScrollBox(PageControl1.ActivePage.Controls[0]).Destroy;
                   // Close the active page
            PageControl1.ActivePage.Free; // Closes and Frees the ActivePage
            PageControl1.SelectNextPage(False);
            UpdateControls;
          end;
        mrCancel: Abort;
      end;
    end
    else
    begin
      TImageScrollBox(PageControl1.ActivePage.Controls[0]).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 TImageScrollBox(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];
            TImageScrollBox(PageControl1.ActivePage.Controls[0]).Destroy;
                // Close the active page
            PageControl1.ActivePage.Free; // Closes and Frees the ActivePage
            PageControl1.SelectNextPage(False);
            UpdateControls;
          end;
        mrCancel: Abort;
      end;
    end
    else
    begin
      TImageScrollBox(PageControl1.ActivePage.Controls[0]).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
  Ext: string;
  DIBGraphic: TDibGraphic;
begin
  BeginHourglass;
  try
    DIBGraphic := TDibGraphic(TImageScrollBox(PageControl1.ActivePage.Controls[0]).Graphic);
    if (FFileName = '') then
      FileSaveAs1Execute(Sender)
    else begin
      Ext := AnsiUpperCase(ExtractFileExt(FFileName));
      if Ext = '' then Ext := '.Bmp';
      DIBGraphic := NewDibGraphic(Ext);
      DIBGraphic.Assign(TImageScrollBox(PageControl1.ActivePage.Controls[0]).Graphic);
      DIBGraphic.SaveToFile(FFileName);
      TImageScrollBox(PageControl1.ActivePage.Controls[0]).Tag := 0;
    end;
  finally EndHourglass; end;
end;

procedure TFormMain.FileSaveAs1Execute(Sender: TObject);
var
  SaveDialog: TSavePictureDialog;
begin
  if PageControl1.PageCount <> 0 then
  begin
    SaveDialog := TSavePictureDialog.Create(nil);
    try
      SaveDialog.Filter := GraphicFilter(TDibGraphic);
      SaveDialog.DefaultExt := '*.bmp';
      if SaveDialog.Execute then begin
        FFileName := SaveDialog.FileName;
        if FileExists(FFileName) and
          (MessageDlg('File ' + FFileName + ' exists.'#13 + ' Overwrite ?',
          mtConfirmation, [mbYes, mbNo], 0) <> mrYes) then
          Abort;
        FileSave1Execute(Sender);
        PageControl1.ActivePage.Caption := FFilename;
      end;
    finally SaveDialog.Free; end;
  end;
end;

{--------------------------------------------------------------------------}

procedure TFormMain.FileExit1Execute(Sender: TObject);
begin
  Close;
end;

procedure TFormMain.EditCopy1Execute(Sender: TObject);
begin
  if TImageScrollBox(PageControl1.ActivePage.Controls[0]).MouseHandler as TRubberBandMouseHandler <> nil
    then
    with TImageScrollBox(PageControl1.ActivePage.Controls[0]).MouseHandler as TRubberBandMouseHandler do
      if SelectionActive then
        CopySelectionToClipBoard
      else
        if TImageScrollBox(PageControl1.ActivePage.Controls[0]).Graphic <> nil then
          Clipboard.Assign(TImageScrollBox(PageControl1.ActivePage.Controls[0]).Graphic);
  UpdateControls;
end;

procedure TFormMain.EditPaste1Execute(Sender: TObject);
var
  DibGraphic: TDibGraphic;
begin
    // Create new image
  AddControls(Sender);
  if Clipboard.HasFormat(CF_BITMAP) then begin
    if TImageScrollBox(PageControl1.ActivePage.Controls[0]).Graphic is TDibGraphic then begin
      TDibGraphic(TImageScrollBox(PageControl1.ActivePage.Controls[0]).Graphic).Assign(Clipboard);
    end
    else begin
      DibGraphic := TDibGraphic.Create;
      try
        DibGraphic.Assign(Clipboard);
        TImageScrollBox(PageControl1.ActivePage.Controls[0]).Graphic := DibGraphic;
      finally DibGraphic.Free; end;
    end;
    TImageScrollBox(PageControl1.ActivePage.Controls[0]).Tag := 0;
    FFileName := '';
    Tabsheet.ImageIndex := 7;
    TImageScrollBox(PageControl1.ActivePage.Controls[0]).Redraw(True);
  end;
end;

procedure TFormMain.EditCrop1Execute(Sender: TObject);
begin
  TImageScrollBox(PageControl1.ActivePage.Controls[0]).SaveUndo;
  if TImageScrollBox(PageControl1.ActivePage.Controls[0]).MouseHandler as TRubberBandMouseHandler <> nil
    then
    with TImageScrollBox(PageControl1.ActivePage.Controls[0]).MouseHandler as TRubberBandMouseHandler do
      if SelectionActive then
      begin
        CropToSelection;
        TImageScrollBox(PageControl1.ActivePage.Controls[0]).Tag := 1;
        ShowImageDimensions;
      end
      else
        ShowMessage('Please select an area of the image to crop.');
  TImageScrollBox(PageControl1.ActivePage.Controls[0]).Invalidate;
end;

procedure TFormMain.HelpAbout1Execute(Sender: TObject);
begin
  ShellAbout(Application.Handle, 'Apprehend 2001 Screen Capture',
    'More info at: http://www.software.adirondack.ny.us', Application.Icon.Handle);
end;

procedure TFormMain.HelpContents1Execute(Sender: TObject);
begin
  Application.HelpCommand(HELP_FINDER, 0);
end;

procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  i: integer;
begin
  if PageControl1.PageCount <> 0 then begin
    for i := 0 to PageControl1.PageCount - 1 do begin
      if TImageScrollBox(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: FileSave1Execute(Self);
          mrNo: CanClose := True;
          mrCancel: Abort;
        end;
      end;
      TImageScrollBox(PageControl1.ActivePage.Controls[0]).Free;
    // close the active page
      PageControl1.ActivePage.Free;
      PageControl1.SelectNextPage(False);
    end;
  end;
  if Clipboard.HasFormat(CF_PICTURE) then
    case MessageDlg(' The clipboard contains an image. Remove image from Clipboard?',
      mtConfirmation, [mbYes, mbNo], 0) of
      mrYes: Clipboard.Clear;
      mrNo: CanClose := True;
    end; // case
  UpdateControls;
end;

procedure TFormMain.ImageScrollBoxImageMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  TImageScrollBox(PageControl1.ActivePage.Controls[0]).SetFocus;
end;

procedure TFormMain.ImageScrollBoxImageMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  with TImageScrollBox(PageControl1.ActivePage.Controls[0]).MouseHandler as TRubberBandMouseHandler do
    if not SelectionActive then
      StatusBar1.Panels[2].Text := ' ( ' + IntToStr(X) + ' , ' + IntToStr(Y) + ' ) ';
end;

procedure TFormMain.ImageScrollBoxImageMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
//
end;

function TFormMain.GetGraphic: TDibGraphic;
begin
  Result := nil;
  if PageControl1.PageCount <> 0 then
    Result := (TDibGraphic(TImageScrollBox(PageControl1.ActivePage.Controls[0]).Graphic));
end;

procedure TFormMain.OnProgress(const Sender: TObject;
  const PercentProgress: Byte);
begin
  if (PercentProgress < 100) then begin
    ProgressBar1.Visible := True;
    ProgressBar1.Position := PercentProgress;
    ProgressBar1.Update;
    frmStatus.lblStatus.Update;
  end
  else begin
    ProgressBar1.Visible := False;
    ProgressBar1.Position := 0;
  end;
end;

procedure TFormMain.ShowImageDimensions;
begin
  if not TImageScrollBox(PageControl1.ActivePage.Controls[0]).Graphic.Empty then
    StatusBar1.Panels[3].Text := ' Height: ' +
      IntToStr(TImageScrollBox(PageControl1.ActivePage.Controls[0]
      ).Graphic.BitmapInfo.BmpHeader.biHeight) + ' pixels' +
      '  Width: ' + IntToStr(TImageScrollBox(PageControl1.ActivePage.Controls[0]
      ).Graphic.BitmapInfo.BmpHeader.biWidth) +
      ' pixels '
  else
    StatusBar1.Panels[3].Text := '         ';
  TImageScrollBox(PageControl1.ActivePage.Controls[0]).Hint := 'Height: ' +
    IntToStr(TImageScrollBox(PageControl1.ActivePage.Controls[0]).Graphic.BitmapInfo.BmpHeader.biHeight
    ) + ' pixels' +
    '  Width: ' + IntToStr(TImageScrollBox(PageControl1.ActivePage.Controls[0]
    ).Graphic.BitmapInfo.BmpHeader.biWidth) + ' pixels';
end;

procedure TFormMain.ShowImageFormat;
begin
  case GetGraphic.ImageFormat of
    ifBlackWhite: StatusBar1.Panels[1].Text := ' 1 bit Black & White ';
    ifGray16: StatusBar1.Panels[1].Text := ' 4 bit 16 shade gray ';
    ifGray256: StatusBar1.Panels[1].Text := ' 8 bit 256 shade gray ';
    ifColor16: StatusBar1.Panels[1].Text := ' 4 bit 16 colors ';
    ifColor256: StatusBar1.Panels[1].Text := ' 8 bit 256 colors ';
    ifTrueColor: StatusBar1.Panels[1].Text := ' 24 bit True color ';
  else
    StatusBar1.Panels[1].Text := ' Unknown image format ';
  end; // case
end;

procedure TFormMain.ShowZoomPercent;
var
  Zoom: single;
begin
  Zoom := TImageScrollBox(PageControl1.ActivePage.Controls[0]).ZoomPercent;
  try
    ZoomCombo.Text := Format('%*.*f', [3, 0, Zoom]);
  finally ZoomCombo.Text := '100'; end;
end;

procedure TFormMain.ImageLoaded;
var
  DIBGraphic: TDibGraphic;
begin
  DIBGraphic := GetGraphic;
  if DIBGraphic = nil then
    Exit;
end;

procedure TFormMain.OnAcquire(const DibHandle: THandle;
  const XDpi: Word;
  const YDpi: Word;
  const CallBackData: LongInt);
var
  DIBGraphic: TDibGraphic;
  pScanInfo: TpScanInfo;
begin
  pScanInfo := TpScanInfo(CallBackData);
  if pScanInfo^.MultiPage then begin
    pScanInfo^.Graphic.AssignFromDibHandle(DibHandle);
    pScanInfo^.Graphic.XDotsPerInch := XDpi;
    pScanInfo^.Graphic.YDotsPerInch := YDpi;
    if pScanInfo^.Graphic.ImageFormat = ifBlackWhite then
      pScanInfo^.Graphic.Compression := tcGroup4
    else
      pScanInfo^.Graphic.Compression := tcPackBits;
    pScanInfo^.Stream.Seek(0, soFromBeginning);
    if pScanInfo^.ImageCount = 0 then
      pScanInfo^.Graphic.SaveToStream(pScanInfo^.Stream)
    else
      pScanInfo^.Graphic.AppendToStream(pScanInfo^.Stream);
      // display some visual feedback by displaying each image scanned one by one.
    TImageScrollBox(PageControl1.ActivePage.Controls[0]).Graphic := pScanInfo^.Graphic;
    Self.FFileName := '';
    TImageScrollBox(PageControl1.ActivePage.Controls[0]).Tag := 0;
    Application.ProcessMessages;
    Inc(pScanInfo^.ImageCount);
    Self.ImageLoaded;
  end
  else begin
    DIBGraphic := TDibGraphic.Create;
    try
      DIBGraphic.AssignFromDIBHandle(DibHandle);
      DIBGraphic.XDotsPerInch := XDpi;
      DIBGraphic.YDotsPerInch := YDpi;
      TImageScrollBox(PageControl1.ActivePage.Controls[0]).Graphic := DIBGraphic;
      TImageScrollBox(PageControl1.ActivePage.Controls[0]).Tag := 0;
      Self.FFileName := '';
      Self.ImageLoaded;
    finally DIBGraphic.Free; end;
  end;
end;

procedure TFormMain.ImageScrollBoxRubberbandChange(const Rect: TRect);
begin
  with TImageScrollBox(PageControl1.ActivePage.Controls[0]).MouseHandler as TRubberBandMouseHandler do
  begin
    if SelectionActive then
      StatusBar1.Panels[2].Text := ' ( ' + IntToStr(abs(Rect.Right - Rect.left)) +
        ' x ' +
        IntToStr(abs(Rect.Bottom - Rect.Top)) + ' ) '
    else
      StatusBar1.Panels[2].Text := '';
  end;
end;

function RemoveChar(const Str: string;
  const Ch: Char): string;
var
  Index: Integer;
begin
  Result := Str;
  for Index := Length(Result) downto 1 do
  begin
    if Result[Index] = Ch then
      Delete(Result, Index, 1);
  end;
end;

procedure TFormMain.PageEditChange(Sender: TObject);
begin
  if PageControl1.PageCount <> 0 then begin
    // show image dimensions in status bar