unit MAIN;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
  StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
  ActnList, ToolWin, ImgList, jpegencoder, pngencoder, bmpencoder, bitmapimage ;

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    FileOpenItem: TMenuItem;
    FileCloseItem: TMenuItem;
    Window1: TMenuItem;
    Help1: TMenuItem;
    N1: TMenuItem;
    FileExitItem: TMenuItem;
    WindowCascadeItem: TMenuItem;
    WindowTileItem: TMenuItem;
    WindowArrangeItem: TMenuItem;
    HelpAboutItem: TMenuItem;
    OpenDialog: TOpenDialog;
    FileSaveItem: TMenuItem;
    FileSaveAsItem: TMenuItem;
    Edit1: TMenuItem;
    CutItem: TMenuItem;
    CopyItem: TMenuItem;
    PasteItem: TMenuItem;
    WindowMinimizeItem: TMenuItem;
    StatusBar: TStatusBar;
    ActionList1: TActionList;
    EditCut1: TEditCut;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    FileSave1: TAction;
    FileExit1: TAction;
    FileOpen1: TAction;
    FileSaveAs1: TAction;
    WindowCascade1: TWindowCascade;
    WindowTileHorizontal1: TWindowTileHorizontal;
    WindowArrangeAll1: TWindowArrange;
    WindowMinimizeAll1: TWindowMinimizeAll;
    HelpAbout1: TAction;
    FileClose1: TWindowClose;
    WindowTileVertical1: TWindowTileVertical;
    WindowTileItem2: TMenuItem;
    ToolBar2: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ImageList1: TImageList;
    ProgressBar: TProgressBar;
    SaveDialog: TSaveDialog;
    procedure FileNew1Execute(Sender: TObject);
    procedure FileOpen1Execute(Sender: TObject);
    procedure HelpAbout1Execute(Sender: TObject);
    procedure FileExit1Execute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FileSave1Execute(Sender: TObject);
    procedure FileSaveAs1Execute(Sender: TObject);
  private
    { Private declarations }

    show_progressive : Boolean ;
    jpeg_encoder : TJpegEncoder ;
    png_encoder : TPngEncoder ;
    bmp_encoder : TBmpEncoder ;
	  Procedure CreateMDIChild(filename : String);
    Procedure WMDropFiles (var msg : TMessage) ; Message WM_DROPFILES ;

  public
    Property ShowProgressive : Boolean read show_progressive write show_progressive ;
    Procedure ShowProgressBar ;

  end;

var
  MainForm: TMainForm;

Procedure ProgressFunction (
                        code : TBitmapImageCoder ;
			                  data : PROGRESSDATA ;
			                  currentpass : Cardinal ;
			                  passcount : Cardinal ;
                        description : String ;
			                  progress : Cardinal ;
			                  var cancel : Boolean) ;


implementation
{$R *.dfm}

uses CHILDWIN, SHELLAPI, about, imagetype, JpegDecoder ;
Procedure ProgressFunction (
                        code : TBitmapImageCoder ;
			                  data : PROGRESSDATA ;
			                  currentpass : Cardinal ;
			                  passcount : Cardinal ;
                        description : String ;
			                  progress : Cardinal ;
			                  var cancel : Boolean) ;
 Begin
 MainForm.ProgressBar.Position := progress ;
 Application.ProcessMessages ;
 End ;

procedure TMainForm.CreateMDIChild(filename : String) ;
  Var
    child : TMDIChild ;
    oldstate : Boolean ;
  Begin
  oldstate := Enabled ;
  Enabled := false ;
  Try
    Child := TMDIChild.Create (Application);
    try
      Child.ReadImage (filename) ;
    except else
      Child.Destroy ;
      Raise
      End ;
    if Child.ImageFormat = UnknownImage Then
      Begin
      Child.Destroy ;
      Raise Exception.Create ('Unknown or Invalid Image Format') ;
      End ;
  Finally
    Enabled := oldstate ;
    End ;
  end;

procedure TMainForm.FileNew1Execute(Sender: TObject);
begin
  CreateMDIChild('NONAME' + IntToStr(MDIChildCount + 1));
end;

procedure TMainForm.FileOpen1Execute(Sender: TObject);
begin
  if OpenDialog.Execute then
    CreateMDIChild(OpenDialog.FileName);
end;

procedure TMainForm.HelpAbout1Execute(Sender: TObject);
begin
  AboutBox.ShowModal;
end;

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

Procedure TMainForm.WMDropFiles (var msg : TMessage) ;
  Const
    FILENAME_MAX = 260 ;
  var
    oldstate : Boolean ;
    drop : HDROP ;
    buffer : Array [1..FILENAME_MAX] of Char ;
    count : Cardinal ;
    ii : Cardinal ;
  Begin
  drop := HDROP (msg.WParam) ;
  oldstate := Enabled ;
  Enabled := false ;
  Try
    count := DragQueryFile (drop, $FFFFFFFF, Nil, 0) ;
    for ii := 0 TO count - 1 Do
      Begin
      DragQueryFile (drop, ii, @buffer [1], FILENAME_MAX) ;
      CreateMDIChild (buffer) ;
      End ;
  Finally
    Enabled := oldstate ;
    DragFinish (drop) ;
    End ;
  End ;

procedure TMainForm.FormCreate(Sender: TObject);
  Var
    style : Cardinal ;
  begin
//	Application->OnHint = ShowHint;
//	Screen->OnActiveFormChange = UpdateMenuItems;

  // Allow the user to drop files.
  DragAcceptFiles (Handle, true) ;

  // Here we remove the shading along the bottom and right from the
  // progress bar.
  style := GetWindowLong (ProgressBar.Handle, GWL_EXSTYLE) ;
  style := style AND NOT WS_EX_STATICEDGE ;
  SetWindowLong (ProgressBar.Handle, GWL_EXSTYLE, style) ;
  end;

Procedure TMainForm.ShowProgressBar ;
  Begin
  // We use this function to dislay the progress bar.
  ProgressBar.Parent := MainForm.StatusBar ;
  ProgressBar.Left := MainForm.StatusBar.ClientRect.Left ;
  ProgressBar.Top := MainForm.StatusBar.ClientRect.Top ;
  ProgressBar.Width := MainForm.StatusBar.ClientRect.Right
                     - MainForm.StatusBar.ClientRect.Left ;
  ProgressBar.Height := MainForm.StatusBar.ClientRect.Bottom
                      - MainForm.StatusBar.ClientRect.Top ;
  ProgressBar.Visible := true ;
  End ;


procedure TMainForm.FileSave1Execute(Sender: TObject);
  Var
    child : TMDIChild ;
    filename, ext : String ;
    encoder : TBitmapImageEncoder ;
  begin
  child := ActiveMDIChild As TMDIChild ;

  Enabled := false ;
  Cursor := crHourGlass ;
  try
    filename := child.Caption ;
    ext := UpperCase (ExtractFileExt (filename)) ;

    MainForm.ShowProgressBar ;

    if ext = '.JPG' Then
  Begin
      encoder := jpeg_encoder
  ;
   (encoder as TJpegEncoder).Grayscale := true ;
   (encoder as Tjpegencoder).quality := 9 ;
End
    else if ext = '.PNG' Then
      encoder := png_encoder
    else if ext = '.BMP' Then
      encoder := bmp_encoder
    else
      Raise Exception.Create ('Unknown file extension') ;

    encoder.setProgressFunction (ProgressFunction, Nil) ;
    encoder.writeImageFile (filename, child.Image) ;
  Finally
    Enabled := true ;
    Cursor := crDefault ;
    ProgressBar.Visible := false ;
    End ;

end;

procedure TMainForm.FileSaveAs1Execute(Sender: TObject);
  Var
    child : TMDIChild ;
    filename, ext : String ;
    encoder : TBitmapImageEncoder ;
  begin
  encoder := Nil ; // Keep compiler from warning.

  child := ActiveMDIChild As TMDIChild ;

  filename := child.Caption ;
  ext := UpperCase (ExtractFileExt (filename)) ;
  filename := Copy (filename, 1, Length (filename) - Length (ext)) ;
  SaveDialog.FileName := filename ;
  if Not SaveDialog.Execute Then
    Exit ;

  filename := SaveDialog.FileName ;
  ext := UpperCase (ExtractFileExt (filename)) ;
  if ext = '' Then
    Begin
    Case SaveDialog.FilterIndex Of
      1: ext := '.JPG' ;
      2: ext := '.PNG' ;
      3: ext := '.BMP' ;
      End ;
    filename := filename + ext ;
    End ;


  MainForm.ShowProgressBar ;
  Cursor := crHourGlass ;
  Try
    if ext = '.JPG' Then
      encoder := TJpegEncoder.Create
    else if ext = '.PNG' Then
      encoder := TPngEncoder.create
    else if ext = '.BMP' Then
      encoder := TBmpEncoder.create
    else
      Raise Exception.Create ('Invalid file extension') ;

    encoder.setProgressFunction (ProgressFunction, Nil) ;
    encoder.writeImageFile (filename, child.Image) ;
    child.Caption := filename ;
  Finally
    ProgressBar.Visible := false ;
    Cursor := crDefault ;
    encoder.destroy ;
    End ;
  end;

End.
