main.pas

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

    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;
    finally
      DIBGraphic.Free;
    end;
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := 0;
    Self.FFileName := '';
    Self.ImageLoaded;
  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
    ShowImageDimensions;
    // show image format in status bar
    ShowImageFormat;
    // update zoom edit
    ShowZoomPercent;
  end;
end;

procedure TFormMain.OptionsMinimize1Execute ( Sender: TObject );
begin
  Minimize1.Checked := not Minimize1.Checked;
  ASGScreenCapture1.Minimize := Minimize1.Checked;
end;

procedure TFormMain.OptionsAutomatic1Execute ( Sender: TObject );
begin
  Automatic1.Checked := not Automatic1.Checked;
  ASGScreenCapture1.Auto := Automatic1.Checked;
end;

procedure TFormMain.OptionsDelay1Execute ( Sender: TObject );
begin
  DelayDlg.edScreenDelay.Text := IntToStr ( ASGScreenCapture1.Delay );
  if DelayDlg.ShowModal = mrOk then
    ASGScreenCapture1.Delay := StrToInt ( DelayDlg.edScreenDelay.Text );
end;

procedure TFormMain.ImageType1Execute ( Sender: TObject );
var
  Form: TFormatConversionForm;
  DIBGraphic: TDibGraphic;
  Transform: TImageFormatTransform;
  DestFormat: TImageFormat;
  Quantize: Boolean;
  Dither: Boolean;
begin
  DIBGraphic := GetGraphic;
  if not DIBGraphic.Empty then begin
    BeginHourglass;
    Form := TFormatConversionForm.Create ( nil );
    try
      Form.SourceFormat := DIBGraphic.ImageFormat;
      if Form.ShowModal <> mrOk then begin
        EndHourglass;
        Abort;
      end;
      Application.ProcessMessages;
      DestFormat := Form.DestFormat;
      Quantize := Form.QuantizeCB.Checked;
      Dither := Form.DitherCB.Checked;
    finally
      Form.Free;
      EndHourglass;
    end;
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).SaveUndo;
    FUndoGraphic.Assign ( GetGraphic );
    Transform := TImageFormatTransform.Create;
    try
      Transform.OnProgress := Self.OnProgress;
      Transform.ImageFormat := DestFormat;
      Transform.Quantize := Quantize;
      Transform.Dither := Dither;
         // Setup and Show Status Form
      frmStatus.Show;
      frmStatus.lblStatus.Caption := 'Changing image type (Color)...';
      frmStatus.lblStatus.Update;
      Sleep ( 100 );
      Transform.ApplyOnDest ( FUndoGraphic, GetGraphic );
      case Transform.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
    finally
      Transform.Free;
      EndHourglass;
    end;
    frmStatus.Hide;
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := TImageScrollBox (
      PageControl1.ActivePage.Controls[ 0 ] ).Tag + 1;
    EndHourglass;
  end; // if
end;

procedure TFormMain.ImageShadesOfGray256Execute ( Sender: TObject );
var
  Transform: TImageFormatTransform;
  DIBGraphic: TDibGraphic;
begin
  try
    DIBGraphic := GetGraphic;
    if not DIBGraphic.Empty then begin
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).SaveUndo;
      Transform := TImageFormatTransform.Create;
      try
        Transform.OnProgress := Self.OnProgress;
        Transform.ImageFormat := ifGray256;
        Transform.Quantize := ImageQuantize1.Checked;
        Transform.Dither := ImageDither1.Checked;
            // Setup and Show Status Form
        frmStatus.lblStatus.Caption := 'Changing image type to 256 shades of gray...';
        frmStatus.lblStatus.Update;
        frmStatus.Show;
        TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).SaveUndo;
        FUndoGraphic.Assign ( GetGraphic );
        Transform.ApplyOnDest ( FUndoGraphic, GetGraphic );
        case Transform.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
      finally
        Transform.Free;
        TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := 1;
        EndHourglass;
      end;
    end;
  finally
    frmStatus.Hide;
    EndHourglass;
  end;
end;

procedure TFormMain.ImageShadesOfGray16Execute ( Sender: TObject );
var
  Transform: TImageFormatTransform;
  DIBGraphic: TDibGraphic;
begin
  try
    DIBGraphic := GetGraphic;
    if not DIBGraphic.Empty then begin
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).SaveUndo;
      FUndoGraphic.Assign ( GetGraphic );
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).SaveUndo;
      Transform := TImageFormatTransform.Create;
      try
        Transform.OnProgress := Self.OnProgress;
        Transform.ImageFormat := ifGray16;
        Transform.Quantize := ImageQuantize1.Checked;
        Transform.Dither := ImageDither1.Checked;
      // Setup and Show Status Form
        frmStatus.lblStatus.Caption := 'Changing image type to 16 shades of gray...';
        frmStatus.lblStatus.Update;
        frmStatus.Show;
        TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).SaveUndo;
        FUndoGraphic.Assign ( GetGraphic );
        Transform.ApplyOnDest ( FUndoGraphic, GetGraphic );
        case Transform.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
      finally
        Transform.Free;
        EndHourglass;
      end;
    end;
  finally
    frmStatus.Hide;
    EndHourglass;
  end;
  TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := 1;
end;

procedure TFormMain.ImageBlackAndWhite1Execute ( Sender: TObject );
var
  Transform: TImageFormatTransform;
  DIBGraphic: TDibGraphic;
begin
  try
    DIBGraphic := GetGraphic;
    if not DIBGraphic.Empty then begin
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).SaveUndo;
      FUndoGraphic.Assign ( GetGraphic );
      Transform := TImageFormatTransform.Create;
      try
        Transform.OnProgress := Self.OnProgress;
        Transform.ImageFormat := ifBlackWhite;
        Transform.Quantize := ImageQuantize1.Checked;
        Transform.Dither := ImageDither1.Checked;
      // Setup and Show Status Form
        frmStatus.lblStatus.Caption := 'Changing image type to black and white...';
        frmStatus.lblStatus.Update;
        frmStatus.Show;
        Transform.ApplyOnDest ( FUndoGraphic, GetGraphic );
        TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := 1;
        case Transform.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
      finally
        Transform.Free;
        EndHourglass;
      end;
    end;
  finally
    frmStatus.Hide;
    TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := 1;
    EndHourglass;
  end;
end;

procedure TFormMain.ImageSixteenColors1Execute ( Sender: TObject );
var
  Transform: TImageFormatTransform;
  DIBGraphic: TDibGraphic;
begin
  try
    DIBGraphic := GetGraphic;
    if not DIBGraphic.Empty then begin
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).SaveUndo;
      Transform := TImageFormatTransform.Create;
      try
        Transform.OnProgress := Self.OnProgress;
        Transform.ImageFormat := ifColor16;
        Transform.Quantize := ImageQuantize1.Checked;
        Transform.Dither := ImageDither1.Checked;
      // Setup and Show Status Form
        frmStatus.lblStatus.Caption := 'Changing image type 16 colos)...';
        frmStatus.lblStatus.Update;
        frmStatus.Show;
        TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).SaveUndo;
        FUndoGraphic.Assign ( GetGraphic );
        Transform.ApplyOnDest ( FUndoGraphic, GetGraphic );
        TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := 1;
        case Transform.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
      finally
        Transform.Free;
        EndHourglass;
      end;
    end;
  finally
    frmStatus.Hide;
    EndHourglass;
  end;
end;

procedure TFormMain.ImageTrueColor1Execute ( Sender: TObject );
var
  Transform: TImageFormatTransform;
  DIBGraphic: TDibGraphic;
begin
  try
    DIBGraphic := GetGraphic;
    if not DIBGraphic.Empty then begin
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).SaveUndo;
      Transform := TImageFormatTransform.Create;
      try
        Transform.OnProgress := Self.OnProgress;
        Transform.ImageFormat := ifTrueColor;
        Transform.Quantize := ImageQuantize1.Checked;
        Transform.Dither := ImageDither1.Checked;
      // Setup and Show Status Form
        frmStatus.lblStatus.Caption := 'Changing image type to true color...';
        frmStatus.lblStatus.Update;
        frmStatus.Show;
        TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).SaveUndo;
        FUndoGraphic.Assign ( GetGraphic );
        Transform.ApplyOnDest ( FUndoGraphic, GetGraphic );
        TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).Tag := 1;
        case Transform.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
      finally
        Transform.Free;
        EndHourglass;
      end;
    end;
  finally
    frmStatus.Hide;
    EndHourglass;
  end;
end;

procedure TFormMain.ImageColors256Execute ( Sender: TObject );
var
  Transform: TImageFormatTransform;
  DIBGraphic: TDibGraphic;
begin
  try
    DIBGraphic := GetGraphic;
    if not DIBGraphic.Empty then begin
      TImageScrollBox ( PageControl1.ActivePage.Controls[ 0 ] ).SaveUndo;