frmmain.pas

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

          HorzScrollBar.Range := TImage(PageControl1.ActivePage.Tag).Picture.Width;
          VertScrollBar.Range := TImage(PageControl1.ActivePage.Tag).Picture.Height;
        end;
        bLeftDown := false;
        PointStart.X := 0;
        PointEnd.X := 0;
        PointStart.Y := 0;
        PointEnd.Y := 0;
        Bitmap.Free;
        Invalidate;
        Refresh;
        // reset scale 
        TrackBar1.Hint := IntToStr(TrackBar1.Position) + '%';
        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;
  end;
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 TImage(PageControl1.ActivePage.Tag).Tag = 1 then
      begin
        case MessageDlg(PageControl1.ActivePage.Caption + ' is not saved. Save it?',
          mtConfirmation, [mbYes, mbNo, mbCancel], 0) of
          mrYes: FileSaveAs1Execute(Self);
          mrNo: Canclose := True;
          mrCancel: Abort;
        end;
      end;
      TImage(PageControl1.ActivePage.Tag).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.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.PageControl1Change(Sender: TObject);
begin
  if not TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Empty then begin
     // 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 ';
  end
  else
    StatusBar1.Panels[1].Text := ' ';
  StatusBar1.Panels[2].Text := ' ';
  StatusBar1.Panels[3].Text := ' ';
end;

procedure TFormMain.CopySelectionToClipboard;
var
  bitmap: TBitmap;
  sourcerect: TRect;
  destrect: TRect;
  StretchFactor_X: Integer;
  StretchFactor_Y: Integer;
  Clipboard: TClipboard;
begin
  if (PageControl1.PageCount <> 0) and (PointEnd.X > PointStart.X) and (PointEnd.Y > PointStart.Y) then
  begin
    Clipboard := nil;
     // Erase the the rubberband created with PImage1MouseMove
    DrawRubberband;
    begin
      // If image present...
      if Assigned(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap) then
      begin
        TMPBmp.Assign(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap);
        Bitmap := TBitmap.Create;
        if Image.Stretch then
        begin
          StretchFactor_X := Round(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.Width / TImage(
            PageControl1.ActivePage.Tag).Picture.Bitmap.Width);
          StretchFactor_Y := Round(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.Height / TImage(
            PageControl1.ActivePage.Tag).Picture.Bitmap.Height);
          Bitmap.Width := (PointEnd.X * StretchFactor_X) - (PointStart.X * StretchFactor_X);
          Bitmap.Height := (PointEnd.Y * StretchFactor_Y) - (PointStart.Y * StretchFactor_Y);
          SourceRect.Left := PointStart.X * StretchFactor_X;
          SourceRect.Top := PointStart.Y * StretchFactor_Y;
          SourceRect.Right := PointEnd.X * StretchFactor_X;
          SourceRect.Bottom := PointEnd.Y * StretchFactor_Y;
          DestRect.Left := 0;
          DestRect.Top := 0;
          DestRect.Right := (PointEnd.X * StretchFactor_X) - (PointStart.X * StretchFactor_X);
          DestRect.Bottom := (PointEnd.Y * StretchFactor_Y) - (PointStart.Y * StretchFactor_Y);
        end else
        begin
          Bitmap.Width := PointEnd.X - PointStart.X;
          Bitmap.Height := PointEnd.Y - PointStart.Y;
          SourceRect.Left := PointStart.X;
          SourceRect.Top := PointStart.Y;
          SourceRect.Right := PointEnd.X;
          SourceRect.Bottom := PointEnd.Y;
          DestRect.Left := 0;
          DestRect.Top := 0;
          DestRect.Right := PointEnd.X - PointStart.X;
          DestRect.Bottom := PointEnd.Y - PointStart.Y;
        end;
        SetStretchBltmode(Bitmap.Canvas.Handle, Stretch_deletescans);
        // Copy selection to Bitmap
        Bitmap.Canvas.CopyRect(DestRect, TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.Canvas,
          SourceRect);
        Bitmap.Palette := TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.Palette;
        // Copy bitmap to clipboard
        Clipboard.Assign(Bitmap);
        // adjust the scrollbox
        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
        StatusBar1.Panels[1].Text := ' Height: ' +
          IntToStr(TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Height) + ' pixels' +
          '  Width: ' + IntToStr(TImage(PageControl1.ActivePage.Tag).Picture.Graphic.Width) +
          ' pixels ';
        // Reset the rubberband
        bLeftDown := false;
        RubberbandVisible := False;
        PointStart.X := 0;
        PointEnd.X := 0;
        PointStart.Y := 0;
        PointEnd.Y := 0;
        Bitmap.Free;
      end;
    end;
  end;
end;

procedure TFormMain.EditDevice1Execute(Sender: TObject);
begin
  TMPBmp.Assign(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap);
  TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat := pfDevice;
  StatusBar1.Panels[4].Text := ' Color Depth: Device';
  EditDevice1.Checked := True;
end;

procedure TFormMain.EditBlackandWhite1Execute(Sender: TObject);
begin
  TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat := pfDevice;
  TMPBmp.Assign(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap);
  TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat := pf1bit;
  StatusBar1.Panels[4].Text := ' Color Depth: Black & White';
  EditBlackandWhite1.Checked := True;
end;

procedure TFormMain.Edit16Color1Execute(Sender: TObject);
begin
  TMPBmp.Assign(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap);
  TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat := pf4bit;
  StatusBar1.Panels[4].Text := ' Color Depth: 16 Color';
  Edit16Color1.Checked := True;
end;

procedure TFormMain.Edit256Color1Execute(Sender: TObject);
begin
  TMPBmp.Assign(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap);
  TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat := pf8bit;
  StatusBar1.Panels[4].Text := ' Color Depth: 256 Color';
  Edit256Color1.Checked := True;
end;

procedure TFormMain.Edit15Bit1Execute(Sender: TObject);
begin
  TMPBmp.Assign(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap);
  TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat := pf15bit;
  StatusBar1.Panels[4].Text := ' Color Depth: 8 Bit High Color';
  Edit15Bit1.Checked := True;
end;

procedure TFormMain.Edit16Bit1Execute(Sender: TObject);
begin
  TMPBmp.Assign(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap);
  TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat := pf16bit;
  StatusBar1.Panels[4].Text := ' Color Depth: 16 Bit High Color';
  Edit16Bit1.Checked := True;
end;

procedure TFormMain.Edit24Bit1Execute(Sender: TObject);
begin
  TMPBmp.Assign(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap);
  TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat := pf24bit;
  StatusBar1.Panels[4].Text := ' Color Depth: 24 Bit True Color';
  Edit16Bit1.Checked := True;
end;

procedure TFormMain.Edit32Bit1Execute(Sender: TObject);
begin
  TMPBmp.Assign(TImage(PageControl1.ActivePage.Tag).Picture.Bitmap);
  TImage(PageControl1.ActivePage.Tag).Picture.Bitmap.PixelFormat := pf32bit;
  StatusBar1.Panels[4].Text := ' Color Depth: 32 Bit True Color';
  Edit32Bit1.Checked := True;
end;

procedure TFormMain.TrackBar1Change(Sender: TObject);
begin
  (Sender as TTrackBar).Hint := IntToStr((Sender as TTrackBar).Position) + '% - F12 Reset';
  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.PctBtnClick(Sender: TObject);
begin
  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.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key = VK_F12 then
   begin
     TrackBar1.Position := 100;
     TrackBar1.Hint := IntToStr(TrackBar1.Position) + '%';
     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;
 if Key = VK_ESCAPE then Close;
end;

procedure TFormMain.FilePrint1Execute(Sender: TObject);
var
  AspectRatio: Single;
  OutputWidth, OutputHeight: Single;
begin
  if not PrintDialog1.Execute then Exit;
  Printer.BeginDoc;
  try
    OutputWidth := TImage(PageControl1.ActivePage.Tag).Picture.Width;
    OutputHeight := TImage(PageControl1.ActivePage.Tag).Picture.Height;
    AspectRatio := OutputWidth / OutputHeight;
    if (OutputWidth < Printer.PageWidth) and
      (OutputHeight < Printer.PageHeight) then
    begin
      if OutputWidth < OutputHeight then
      begin
        OutputHeight := Printer.PageHeight;
        OutputWidth := OutputHeight * AspectRatio;
      end
      else
      begin
        OutputWidth := Printer.PageWidth;
        OutputHeight := OutputWidth / AspectRatio;
      end
    end;
    if OutputWidth > Printer.PageWidth then
    begin
      OutputWidth := Printer.PageWidth;
      OutputHeight := OutputWidth / AspectRatio;
    end;
    if OutputHeight > Printer.PageHeight then
    begin
      OutputHeight := Printer.PageHeight;
      OutputWidth := OutputHeight * AspectRatio;
    end;
    Printer.Canvas.StretchDraw(Rect(0,0,
      Trunc(OutputWidth), Trunc(OutputHeight)),
      TImage(PageControl1.ActivePage.Tag).Picture.Graphic);
  finally
    Printer.EndDoc;
  end;
end;

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

end.