unit Second;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, AppEvent, VCLUtils, ExtDlgs, Struct,
  ClipBrd, Printers, StdCtrls, JPEG, BMP2TIFF;

type
  TCaptureForm = class(TForm)
    Image: TImage;
    SavePictureDialog: TSaveDialog;
    PrintDialog: TPrintDialog;
    procedure FormResize(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure WMSavePicture(var Message: TMessage); message WM_SAVECAPTURE;
    procedure FormDestroy(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    Bitmap: TBitmap;
    procedure Save_To_Image(NameX: String; ImageType: MyImageType);
    procedure PrintImage(Image1: TImage; ExecuteDialog: Boolean);
  public
    { Public declarations }
    ImageNotSaved: Boolean;
    UndoBitmap: TBitmap;
  end;

var
  CaptureForm: TCaptureForm;

implementation

uses Main;

{$R *.DFM}
{$R BMP.RES}

procedure TCaptureForm.FormResize(Sender: TObject);
begin
{  if WindowState = wsMaximized then
   Exit;}

  if (ClientWidth>Image.Width) then
   Image.Left := (ClientWidth - Image.Width) div 2
  else
   Image.Left := 0;

  if (ClientHeight>Image.Height) then
   Image.Top := (ClientHeight - Image.Height) div 2
  else
   Image.Top := 0;
end;

procedure TCaptureForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if MainForm.MDIChildCount - 1 = 0 then
   MainForm.StatusBar.Panels[0].Text := 'No Image';
  Action := caFree;
end;

procedure TCaptureForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if ImageNotSaved then
   begin
     case MsgBox('Save Capture','Capture "'+Caption+'" has not been saved.'+#13#13+
     'Would you like to save it now?',MB_YESNOCANCEL+MB_ICONQUESTION) of
      mrYes: begin
              with SavePictureDialog do
               with MainForm.OutputProperties do
                begin
                  InitialDir := Output_Folder;
                  FileName := Fixed_Name;
                end;
              if SavePictureDialog.Execute then
               begin
                 Save_To_Image(SavePictureDialog.FileName,MainForm.OutputProperties.File_Format);
                 CanClose := True;
               end
              else
              CanClose := False;
             end;
      mrNo: CanClose := True;
      mrCancel: CanClose := False;
      end; {case}
   end;
   if CanClose then
    if Application.MainForm.MDIChildCount=1 then
     SendMessage(Application.MainForm.Handle,WM_DISABLEBUTTONS,0,0);
end;

procedure TCaptureForm.FormCreate(Sender: TObject);
begin
  Bitmap := TBitmap.Create;
  Bitmap.LoadFromResourceName(HInstance, 'BACK');
  Bitmap.Dormant;
  Bitmap.FreeImage;
  ImageNotSaved := True;
  Image.Picture.Bitmap.PixelFormat := pf24bit;
end;

procedure TCaptureForm.Save_To_Image(NameX: String; ImageType: MyImageType);
var
    FImage: TJPEGImage;
begin
  // add extension
  if ExtractFileExt(NameX)='' then
   case ImageType of
    BMP: NameX := NameX + '.BMP';
    JPG: NameX := NameX + '.JPG';
    TIFF: NameX := NameX + '.TIF';
   end; {case}
  if ImageType = BMP then
   Image.Picture.Bitmap.SaveToFile(NameX)
  else
   if ImageType = JPG then
    begin
     FImage := TJPEGImage.Create;
     try
       with FImage do
       begin
         CompressionQuality := MainForm.JPEGProperties.Quality;
         Grayscale := MainForm.JPEGProperties.Grayscale;
         Assign(Image.Picture.Bitmap);
         SaveToFile(NameX);
         // now update view
         if Grayscale then
         begin
          { Must update bitmap }
           Image.Picture.LoadFromFile(NameX);
         end;
       end;
     finally
       FImage.Free;
     end;
    end
  else
   if ImageType = TIFF then
    begin
      WriteTiffToFile(NameX,Image.Picture.Bitmap);
    end;

  Caption := NameX;
  ImageNotSaved := False;
end;

procedure TCaptureForm.PrintImage(Image1: TImage; ExecuteDialog: Boolean);
var
  AspectRatio: Single;
  OutputWidth, OutputHeight: Single;
  CanDoIt: Boolean;
begin
  CanDoIt := True;
  if ExecuteDialog then
  if PrintDialog.Execute then
   CanDoIt := True
  else
   CanDoIt := False
  else
   CanDoIt := True;

  if not CanDoIt then
   Exit;
  Printer.BeginDoc;
  try
    OutputWidth := Image1.Picture.Width;
    OutputHeight := Image1.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)),
      Image1.Picture.Graphic);
  finally
    Printer.EndDoc;
  end;
end;

procedure TCaptureForm.WMSavePicture(var Message: TMessage);
var
   AFormat : Word;
   AData{, APalette }: THandle;
   APalette: HPALETTE;
   Old: MyImageType;

function Get_Format(S: String): MyImageType;
begin
  Result := BMP; // just in case
  if UpperCase(ExtractFileExt(S))='.BMP' then
   Result := BMP
  else
  if UpperCase(ExtractFileExt(S))='.JPG' then
   Result := JPG
  else
  if UpperCase(ExtractFileExt(S))='.JPEG' then
   Result := JPG
  else
  if UpperCase(ExtractFileExt(S))='.TIF' then
   Result := TIFF;
end;

function GetFormat(X: Integer): MyImageType;
begin
  case X of
   1: Result := None;
   2: Result := BMP;
   3: Result := JPG;
  else
   Result := None;
  end; {case}
end;

function GetPrefixName(Prefix, Output_Folder: String; File_Format: MyImageType): String;
var I: Integer;
    OutName, OutNameX: String;
    Folder: String;

function GetNr(X,Y: Integer): String;
var S: String;
begin
  S := IntToStr(X);
  while Length(S)<Y do
   S := '0'+S;
  Result := S;
end;

begin
  I := 0;
    case File_Format of
     BMP: OutNameX := '.BMP';
     JPG: OutNameX := '.JPG';
     TIFF: OutNameX := '.TIF';
    end;
  Folder := Output_Folder;
  if Folder = '' then Folder := ExtractFilePath(Application.ExeName);
  if Folder[Length(Folder)]<>'\' then
   Folder := Folder + '\';
  repeat
    Inc(I);
    OutName := Folder + Prefix + GetNr(I,4) + OutNameX;
  until (not FileExists(OutName));
  Result := OutName;
end;

begin
  case Message.WParam of
  0: {File} begin

  { Detect whether file-naming }
  with MainForm.OutputProperties do
   begin
     if Fixed_Image_Name then
     {Fixed}
     begin
      if Output_Folder = '' then Output_Folder := ExtractFilePath(Application.ExeName);
      if Output_Folder[Length(Output_Folder)]<>'\' then
       Output_Folder := Output_Folder + '\';
       Save_To_Image(Output_Folder+Fixed_Name,File_Format);
     end
     else
      if Auto_Image_Name then
      {Automatic}
        Save_To_Image(GetPrefixName(Auto_Prefix,Output_Folder,File_Format),File_Format)
      else
       { Ask for name }
       begin
         with SavePictureDialog do
          with MainForm.OutputProperties do
           begin
             InitialDir := Output_Folder;
             FileName := Fixed_Name;
           end;
        with SavePictureDialog do
         begin
          Filter := 'All (*.bmp,*.jpg,*.tif)|*.jpg;*.bmp;*.tif|'+GraphicFilter(TBitmap)+'|JPEG Images (*.jpg)|*.jpeg|Targa Image (*.tif)';
          if Execute then
           if GetFormat(SavePictureDialog.FilterIndex)<>None then
            Save_To_Image(SavePictureDialog.FileName,GetFormat(SavePictureDialog.FilterIndex))
           else
            begin
              // autodetect extension and format
              Old := Get_Format(SavePictureDialog.FileName);
              Save_To_Image(SavePictureDialog.FileName,Old)
            end;
         end;
       end; {else ask for name}
   end;
  end;
  1: {Printer} begin
    PrintImage(Image,MainForm.OutputProperties.Show_Dialog_Before_Print);
    Caption := 'Image Sent to Printer';
    ImageNotSaved := False;
  end;
  2: {Clipboard}
  begin
     Caption := 'Saved to Clipboard';
     MainForm.ScreenCapture.Bitmap.SaveToClipBoardFormat(AFormat,AData,APalette);
     Clipboard.SetAsHandle(AFormat,AData);
     ImageNotSaved := False;
  end;
  3: {Catalog}
   begin
     { Do we need to generate auto-name? }
     with MainForm.OutputProperties do
     if Catalog_Ask_Name then
      begin
        with SavePictureDialog do
         with MainForm.OutputProperties do
          begin
           InitialDir := Output_Folder;
           FileName := Fixed_Name;
          end;
        if SavePictureDialog.Execute then
         Save_To_Image(SavePictureDialog.FileName,File_Format)
        else
         ImageNotSaved := True;
      end
     else
      {Automatic}
       if Catalog_Folder<>'' then
        Save_To_Image(GetPrefixName('IMAGE-',Catalog_Folder,File_Format),File_Format)
       else
        Save_To_Image(GetPrefixName('IMAGE-',ExtractFilePath(Application.ExeName),File_Format),File_Format);
   end;
  end; {case}
end;

procedure TCaptureForm.FormDestroy(Sender: TObject);
begin
  Bitmap.ReleaseHandle;
  Bitmap.Free;
  if UndoBitmap <> nil then
   UndoBitmap.Free;
end;

procedure TCaptureForm.FormActivate(Sender: TObject);
begin
  MainForm.Undo1.Enabled := UndoBitmap <> nil;
  MainForm.Undo2.Enabled := MainForm.Undo1.Enabled;
  with MainForm.StatusBar do
   Panels[0].Text := 'Image: '+IntToStr(Image.Picture.Bitmap.Width)+' x '+IntToStr(Image.Picture.Bitmap.Height)+' x 24 bit = '+FloatToStrF(3*Image.Picture.Bitmap.Width*Image.Picture.Bitmap.Height / 1024, ffNumber, 18, 1)+' KB';
end;

procedure TCaptureForm.FormPaint(Sender: TObject);
var
  X, Y, W, H: LongInt;
begin
  with Bitmap do
  begin
    W := Width;
    H := Height;
  end;
  Y := 0;
  while Y < Height do
  begin
    X := 0;
    while X < Width do
    begin
      Canvas.Draw(X, Y, Bitmap);
      Inc(X, W);
    end;
    Inc(Y, H);
  end;
end;

end.
