frmmain.pas

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

    RubberbandVisible := False;
  end;
end;

procedure TFormMain.ProgressUpdate(Sender: TObject; Stage: TProgressStage;
  PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
var
  Progress: string;
begin
  if Stage = psRunning then
  begin
    Caption := Format('%d%%', [PercentDone]);
    Progress := Format('%d%', [PercentDone]);
    ProgressBar1.Position := PercentDone;
  end
  else
  begin
    Caption := 'Apprehend 2000 Demo';
  end;
end;

procedure TFormMain.UpdateControls;
begin
  FileNew1.Enabled := PageControl1.PageCount <> 0;
  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;
  EditCopyToSel1.Enabled := PageControl1.PageCount <> 0;
  EditCopy1.Enabled := PageControl1.PageCount <> 0;
  EditPaste1.Enabled := Clipboard.HasFormat(CF_PICTURE);
  EditCrop1.Enabled := PageControl1.PageCount <> 0;
  Colors1.Enabled := PageControl1.PageCount <> 0;
  EditUndo1.Enabled := PageControl1.PageCount <> 0;
  ExportForArticle1.Enabled := PageControl1.PageCount <> 0;
  TrackBar1.Enabled := PageControl1.PageCount <> 0;
end;

procedure TFormMain.ClearStatusBar;
begin
  StatusBar1.Panels[0].Text := '';
  StatusBar1.Panels[1].Text := '';
  StatusBar1.Panels[2].Text := '';
  StatusBar1.Panels[3].Text := '';
  StatusBar1.Panels[4].Text := '';
end;

procedure TFormMain.DrawRubberband;
var
  Temp: Boolean;
begin
  Temp := TImage(PageControl1.ActivePage.Tag).Picture.Graphic is TJPEGImage;
  if (PageControl1.PageCount <> 0) and not (Temp) then
  begin
    SetROP2(TImage(PageControl1.ActivePage.Tag).Canvas.handle, R2_NOT);
    TImage(PageControl1.ActivePage.Tag).Canvas.Moveto(PointStart.x, PointStart.y);
    TImage(PageControl1.ActivePage.Tag).Canvas.Lineto(PointStart.x, PointEnd.y);
    TImage(PageControl1.ActivePage.Tag).Canvas.Lineto(PointEnd.x, PointEnd.y);
    TImage(PageControl1.ActivePage.Tag).Canvas.Lineto(PointEnd.x, PointStart.y);
    TImage(PageControl1.ActivePage.Tag).Canvas.Lineto(PointStart.x, PointStart.y);
  end;
end;

procedure TFormMain.NewImageDblClick(Sender: TObject);
begin
  if PageControl1.PageCount <> 0 then
  begin
    try
      FullScreen := TFullScreen.Create(Self);
      Screen.Cursor := crDefault;
      // copy image to fullscreen image}
      FullScreen.Image1.Picture.Bitmap.Assign(TImage(PageControl1.ActivePage.Tag).Picture.Graphic);
      FullScreen.ScrollBox1.HorzScrollBar.Range := TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Width;
      FullScreen.ScrollBox1.VertScrollBar.Range := TImage(TImage(PageControl1.ActivePage.Tag)).Picture.Graphic.Height;
      // show the image fullscreen}
      FullScreen.Showmodal;
      Screen.Cursor := crDefault;
    except
      FullScreen.Free;
    end;
  end;
end;

procedure TFormMain.NewImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if PageControl1.PageCount <> 0 then
  begin
    bLeftDown := false;
    Screen.Cursor := crCross;
    if RubberbandVisible then // if Rubberband is visible then erase the rubberband
    begin
      Screen.Cursor := crCross;
      DrawRubberband;
      RubberbandVisible := False;
    end;
    if button = mbLeft then
    begin
      bLeftDown := true;
      Pointstart.X := X;
      Pointstart.Y := Y;
      Pointend.X := X;
      Pointend.Y := Y;
    end;
    if Assigned(TImage(PageControl1.ActivePage.Tag)) then
    begin
      Filename := ExpandFilename(PageControl1.ActivePage.Caption);
      StatusBar1.Panels[2].Text := '(' + IntToStr(X) + ',' + IntToStr(Y);
      StatusBar1.Panels[3].Text := '';
    end;
  end;
end;

procedure TFormMain.NewImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if PageControl1.PageCount <> 0 then
  begin
    StatusBar1.Panels[2].Text := '(' + IntToStr(X) +
      ' , ' + IntToStr(Y) + ')';
    if not bLeftDown then exit;
    DrawRubberband;
    PointEnd.x := X;
    PointEnd.y := Y;
    DrawRubberband;
    // Make sure the rubberband is visible for copy & cropping
    RubberbandVisible := True;
    StatusBar1.Panels[3].Text := '(' + IntToStr(X - Pointstart.X) +
      ' , ' + IntToStr(Y - Pointstart.Y) + ')';
  end;
end;

procedure TFormMain.NewImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if PageControl1.PageCount <> 0 then
  begin
    if not bLeftDown then exit;
    Screen.Cursor := crDefault;
    bLeftDown := false;
    Pointend.X := X;
    Pointend.Y := Y;
    // Store points in public variables to provide cropping method
    // rectangular coordinates
    CL := Pointstart.X;
    CT := Pointstart.Y;
    CB := Pointend.Y;
    CR2 := Pointend.X;
    NW := Pointend.X - Pointstart.X;
    NH := Pointend.Y - Pointstart.Y;
  end;
end;

procedure TFormMain.EditUndo1Execute(Sender: TObject);
begin
  if PageControl1.PageCount <> 0 then
    TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Assign(TmpBmp);
  if TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat = pfDevice then
    StatusBar1.Panels[4].Text := ' Color Depth: Device';
  if TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat = pf1bit then
    StatusBar1.Panels[4].Text := ' Color Depth: Black & White';
  if TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat = pf4bit then
    StatusBar1.Panels[4].Text := ' Color Depth: 16 Color';
  if TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat = pf8bit then
    StatusBar1.Panels[4].Text := ' Color Depth: 256 Color';
  if TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat = pf15bit then
    StatusBar1.Panels[4].Text := ' Color Depth: 15 Bit High Color';
  if TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat = pf16bit then
    StatusBar1.Panels[4].Text := ' Color Depth: 16 Bit High Color';
  if TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat = pf24bit then
    StatusBar1.Panels[4].Text := ' Color Depth: 24 Bit True Color';
  if TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat = pf32bit then
    StatusBar1.Panels[4].Text := ' Color Depth: 32 Bit True Color';
end;

procedure TFormMain.CaptureDesktop1Execute(Sender: TObject);
begin
   // Create new image
  AddControls(Sender);
  if PageControl1.PageCount <> 0 then
  begin
      // Set file information
    TImage(PageControl1.ActivePage.Tag).Picture.Assign(ASGScreenCapture1.CaptureDesktop);
    TImage(PageControl1.ActivePage.Tag).Tag := 1;
    ScrollBox := TScrollbox(PageControl1.ActivePage.Controls[0]);
    with ScrollBox do
    begin
      HorzScrollBar.Range := TImage(PageControl1.ActivePage.Tag).Picture.Width;
      VertScrollBar.Range := TImage(PageControl1.ActivePage.Tag).Picture.Height;
    end;
    if not TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Empty then
     // show image dimensions
      StatusBar1.Panels[1].Text := ' Height: ' +
        IntToStr(TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Height) + ' pixels' +
        '  Width: ' + IntToStr(TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Width) +
        ' pixels '
    else
      StatusBar1.Panels[1].Text := ' ';
    TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat := pfDevice;
    StatusBar1.Panels[4].Text := ' Color Depth: Device';
    TrackBar1.Position := 100;
    PctBtn.Caption := IntToStr(TrackBar1.Position) + '%';
    TImage(PageControl1.ActivePage.Tag).Width := Max(1, Round(TImage(PageControl1.ActivePage.Tag).Picture.Width * TrackBar1.Position / 100));
    TImage(PageControl1.ActivePage.Tag).Height := Max(1, Round(TImage(PageControl1.ActivePage.Tag).Picture.Height * TrackBar1.Position / 100));
    Tabsheet.ImageIndex := 0;
  end;
end;

procedure TFormMain.CaptureArea1Execute(Sender: TObject);
begin
 // Create new image
  AddControls(Sender);
  if PageControl1.PageCount <> 0 then
  begin
      // Set file information
    Filename := 'Untitled';
      // Capture area of screen
    TImage(PageControl1.ActivePage.Tag).Picture.Assign(ASGScreenCapture1.CaptureSelection);
    TImage(PageControl1.ActivePage.Tag).Tag := 1;
    ScrollBox := TScrollbox(PageControl1.ActivePage.Controls[0]);
    with ScrollBox do
    begin
      HorzScrollBar.Range := TImage(PageControl1.ActivePage.Tag).Picture.Width;
      VertScrollBar.Range := TImage(PageControl1.ActivePage.Tag).Picture.Height;
    end;
  end;
  // show image dimensions
  if not TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Empty then
     // show image dimensions
    StatusBar1.Panels[1].Text := ' Height: ' +
      IntToStr(TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Height) + ' pixels' +
      '  Width: ' + IntToStr(TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Width) +
      ' pixels '
  else
    StatusBar1.Panels[1].Text := ' ';
  TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat := pfDevice;
  StatusBar1.Panels[4].Text := ' Color Depth: Device';
  // set tabsheet glyph
  Tabsheet.ImageIndex := 2;
  TrackBar1.Position := 100;
  PctBtn.Caption := IntToStr(TrackBar1.Position) + '%';
  TImage(PageControl1.ActivePage.Tag).Width := Max(1, Round(TImage(PageControl1.ActivePage.Tag).Picture.Width * TrackBar1.Position / 100));
  TImage(PageControl1.ActivePage.Tag).Height := Max(1, Round(TImage(PageControl1.ActivePage.Tag).Picture.Height * TrackBar1.Position / 100));
end;

procedure TFormMain.CaptureActive1Execute(Sender: TObject);
begin
 // Create new image
  AddControls(Sender);
  if PageControl1.PageCount <> 0 then
  begin
      // Set file information
    TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.Assign(ASGScreenCapture1.CaptureActiveWindow);
    TImage(PageControl1.ActivePage.Tag).Tag := 1;
    ScrollBox := TScrollbox(PageControl1.ActivePage.Controls[0]);
    with ScrollBox do
    begin
      HorzScrollBar.Range := TImage(PageControl1.ActivePage.Tag).Picture.Width;
      VertScrollBar.Range := TImage(PageControl1.ActivePage.Tag).Picture.Height;
    end;
    // show image dimensions
    if not TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Empty then
     // show image dimensions
      StatusBar1.Panels[1].Text := ' Height: ' +
        IntToStr(TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Height) + ' pixels' +
        '  Width: ' + IntToStr(TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Width) +
        ' pixels '
    else
      StatusBar1.Panels[1].Text := ' ';
    TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat := pfDevice;
    StatusBar1.Panels[4].Text := ' Color Depth: Device';
  // set tabsheet glyph
    Tabsheet.ImageIndex := 1;
    TrackBar1.Position := 100;
    PctBtn.Caption := IntToStr(TrackBar1.Position) + '%';
    TImage(PageControl1.ActivePage.Tag).Width := Max(1, Round(TImage(PageControl1.ActivePage.Tag).Picture.Width * TrackBar1.Position / 100));
    TImage(PageControl1.ActivePage.Tag).Height := Max(1, Round(TImage(PageControl1.ActivePage.Tag).Picture.Height * TrackBar1.Position / 100));
  end;
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
    TImage(PageControl1.ActivePage.Tag).Picture.Assign(ASGScreenCapture1.CaptureObject);
    TImage(PageControl1.ActivePage.Tag).Tag := 1;
  end; {If}
  ScrollBox := TScrollbox(PageControl1.ActivePage.Controls[0]);
  with ScrollBox do
  begin
    HorzScrollBar.Range := TImage(PageControl1.ActivePage.Tag).Picture.Width;
    VertScrollBar.Range := TImage(PageControl1.ActivePage.Tag).Picture.Height;
  end;
  // show image dimensions
  if not TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Empty then
     // show image dimensions
    StatusBar1.Panels[1].Text := ' Height: ' +
      IntToStr(TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Height) + ' pixels' +
      '  Width: ' + IntToStr(TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Width) +
      ' pixels '
  else
    StatusBar1.Panels[1].Text := ' ';
  TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat := pfDevice;
  StatusBar1.Panels[4].Text := ' Color Depth: Device';
  // set tabsheet glyph
  Tabsheet.ImageIndex := 3;
  TrackBar1.Position := 100;
  PctBtn.Caption := IntToStr(TrackBar1.Position) + '%';
  TImage(PageControl1.ActivePage.Tag).Width := Max(1, Round(TImage(PageControl1.ActivePage.Tag).Picture.Width * TrackBar1.Position / 100));
  TImage(PageControl1.ActivePage.Tag).Height := Max(1, Round(TImage(PageControl1.ActivePage.Tag).Picture.Height * TrackBar1.Position / 100));
end;

procedure TFormMain.FileNew1Execute(Sender: TObject);
begin
  AddControls(Sender);
   // Set the caption of the tabsheet
  TabSheet.Caption := Format('Untitled%d', [PageControl1.ActivePage.PageIndex]);
   // set tabsheet glyph
  Tabsheet.ImageIndex := 6;