// 1999 08/04
unit DelViewMainUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Menus, ExtDlgs ,Jpeg,ShellApi,Clipbrd, ComCtrls,StdCtrls, SPIs,
  IniFiles,SPIBmp;

type
  TDelViewMainForm = class(TForm)
    ScrollBox1: TScrollBox;
    MainImage: TImage;
    MainMenu: TMainMenu;
    FileMen: TMenuItem;
    OpenMen: TMenuItem;
    SaveMen: TMenuItem;
    CloseMen: TMenuItem;
    EditMen: TMenuItem;
    CopyMen: TMenuItem;
    PasteMen: TMenuItem;
    OpPicDlog: TOpenPictureDialog;
    ClearMen: TMenuItem;
    SvPicDlog: TSavePictureDialog;
    SPIs1: TSPIs;
    BmpSaveMen: TMenuItem;
    JpgSaveMen: TMenuItem;
    G_ListBox: TListBox;
    procedure OpenMenClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PasteMenClick(Sender: TObject);
    procedure EditMenClick(Sender: TObject);
    procedure CopyMenClick(Sender: TObject);
    procedure ClearMenClick(Sender: TObject);
    procedure FileMenClick(Sender: TObject);
    procedure MainImageProgress(Sender: TObject; Stage: TProgressStage;
      PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
      const Msg: String);
    procedure CloseMenClick(Sender: TObject);
    procedure SaveMenClick(Sender: TObject);
    procedure SPIs1Search(Sender: TObject; ASPI: TSPI;
      var Accept: Boolean);
    procedure SPIs1PictureRegister(Sender: TObject; ASPI: TInSPI;
      const AExtension, ADescription: String;
      var AGraphicClass: TGraphicClass);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure MainImageDblClick(Sender: TObject);
  private
    { Private 宣言 }
    JpgQuality:1..100;
    JpgProgressive:Boolean;
    AppIniName:string;
    procedure NextList;
    procedure IniWrite;
    procedure IniRead;
    function SaveImage(FileName:string;IsBmp:Boolean):Boolean;
    function LoadImage(FileName:string):Boolean;
    procedure DropFiles(var Msg:TWMDROPFILES); message WM_DROPFILES;
  public
    { Public 宣言 }
  end;

var
  DelViewMainForm: TDelViewMainForm;

implementation

uses JpgOptionFormUnit;

{$R *.DFM}

function TDelViewMainForm.LoadImage(FileName: string):Boolean;
var
  SpBmp:TSPIBitmap;
begin
  Screen.Cursor := crHourGlass;
  Result := False;
  SpBmp:=TSPIBitmap.Create;
  try
    try
      SpBmp.LoadFromFile(FileName);
    except//失敗したら finally へジャンプ
      exit;
    end;
    MainImage.Picture.Assign(SpBmp);
    Caption := Application.Title + ' '+
        ExtractFileName(FileName);
    OpPicDlog.FileName:=FileName;
    Result := True;
  finally
    SpBmp.Free;//Create したら Free
    Screen.Cursor := crDefault;
  end;
end;

procedure TDelViewMainForm.OpenMenClick(Sender: TObject);
begin
  if OpPicDlog.Execute then
    LoadImage(OpPicDlog.FileName);
end;

procedure TDelViewMainForm.FormCreate(Sender: TObject);
begin
  JpgQuality     := 75;
  JpgProgressive := False;
  AppIniName := ChangeFileExt(Application.ExeName,'.ini');
  IniRead;
  if (Top + Height < 10) or (Top > Screen.Height - 30) then Top:=0;
  if (Left + Width < 10)or(Left > Screen.Width - 30) then Top:=0;
  Caption:=Application.Title;
  DragAcceptFiles(Handle, True);
  OpPicDlog.Filter := GraphicFilter(TGraphic);
end;

procedure TDelViewMainForm.DropFiles(var Msg: TWMDROPFILES);
var
  FileName: array [0..255] of Char;
  i, DropFileCount: Integer;
begin
  G_ListBox.Items.Clear;//List を一度カラにします。
  DropFileCount := DragQueryFile(Msg.Drop, Cardinal(-1), nil, 0);
  for i:=0 to DropFileCount-1 do
  begin//D&D されたファイルを List に加えます。
    DragQueryFile(Msg.Drop, i, FileName, SizeOf(FileName)-1);
    G_ListBox.Items.Add(FileName);
  end;
  DragFinish(Msg.Drop);
  NextList;//現在の G_ListBox.ItemIndex は -1 （無選択）
end;

procedure TDelViewMainForm.PasteMenClick(Sender: TObject);
begin
  if (Clipboard.HasFormat(CF_PICTURE)) or
    (Clipboard.HasFormat(CF_BITMAP)) then
      MainImage.Picture.Assign(Clipboard);
end;

procedure TDelViewMainForm.EditMenClick(Sender: TObject);
begin
  PasteMen.Enabled := (Clipboard.HasFormat(CF_PICTURE)) or
      (Clipboard.HasFormat(CF_BITMAP));
  CopyMen.Enabled := MainImage.Picture.Graphic<>nil;
end;

procedure TDelViewMainForm.CopyMenClick(Sender: TObject);
begin
  Clipboard.Assign(MainImage.Picture);
end;

procedure TDelViewMainForm.ClearMenClick(Sender: TObject);
begin
  MainImage.Picture.Graphic := nil;
end;

procedure TDelViewMainForm.FileMenClick(Sender: TObject);
begin
  ClearMen.Enabled := MainImage.Picture.Graphic <> nil;
  SaveMen.Enabled := ClearMen.Enabled;
end;

procedure TDelViewMainForm.MainImageProgress(Sender: TObject;
  Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean;
  const R: TRect; const Msg: String);
var
  TmpS:string;
begin
  TmpS := Application.Title +'  '+
     ExtractFileName(OpPicDlog.FileName);
  case Stage of
    psStarting ://はじまったときの処理
               ;
    psRunning  ://展開中
      Caption  := TmpS +' (' + IntToStr(PercentDone)+' % )';
    psEnding   ://終了
       Caption := TmpS;
   end;
end;

procedure TDelViewMainForm.CloseMenClick(Sender: TObject);
begin
  Close;
end;

function TDelViewMainForm.SaveImage(FileName: string;IsBmp:Boolean): Boolean;
var
  Bmp:TBitmap;
  Jpg:TJPEGImage;
begin
  if IsBmp then // Bmp で保存
  begin
    if MainImage.Picture.Graphic is TBitmap then
    begin
      MainImage.Picture.SaveToFile(FileName);
      Result := True;
    end else
    begin
      Bmp:=TBitmap.Create;
      try
        Bmp.Assign(MainImage.Picture.Graphic);
        Bmp.SaveToFile(FileName);
        Result := True;
      finally
        Bmp.Free;
      end;
    end;
  end else // Jpg で保存
  begin
    Jpg:=TJPEGImage.Create;
    try
      Jpg.Assign(MainImage.Picture.Graphic);
      with TJpgOptionForm.Create(Self) do
      begin
        try
          JpgTrackBar.Position := JpgQuality;
          ProgressiveChBox.Checked := JpgProgressive;
          ShowModal;
          JpgQuality := JpgTrackBar.Position;
          JpgProgressive := ProgressiveChBox.Checked;
        finally
          Release;
        end;
      end;
      Jpg.CompressionQuality := JpgQuality;
      Jpg.ProgressiveEncoding := JpgProgressive;
      Jpg.SaveToFile(FileName);
      Result := True;
    finally
      Jpg.Free;
    end;
  end;
end;

procedure TDelViewMainForm.SaveMenClick(Sender: TObject);
begin
  with SvPicDlog do
  begin
    if (Sender as TMenuItem).Tag > 0 then //BMP
    begin
      FileName:=ChangeFileExt(OpPicDlog.FileName,'.bmp');
      Title := 'Bmp で保存';
      Filter:=
      'ビットマップ (*.bmp)|*.bmp|すべてのファイル (*.*)|*.*';
      DefaultExt:='bmp';
    end else                              //JPG
    begin
      FileName:=ChangeFileExt(OpPicDlog.FileName,'.jpg');
      Title := 'Jpg で保存';
      Filter:=
        'Jpeg ファイル(*.jpg;*.jpeg)|*.jpg;*.jpeg|すべてのファイル (*.*)|*.*';
      DefaultExt:='jpg';
    end;
  end;
  if SvPicDlog.Execute then
    if not SaveImage(SvPicDlog.FileName,(Sender as TMenuItem).Tag > 0) then
      ShowMessage('保存に失敗しました');
end;

procedure TDelViewMainForm.SPIs1Search(Sender: TObject; ASPI: TSPI;
  var Accept: Boolean);
begin
  Accept := ASPI is TInSPI;
end;

procedure TDelViewMainForm.SPIs1PictureRegister(Sender: TObject;
  ASPI: TInSPI; const AExtension, ADescription: String;
  var AGraphicClass: TGraphicClass);
begin
  if (UpperCase(AExtension) = 'JPG') or
         (UpperCase(AExtension) = 'JPEG') then
  begin
    AGraphicClass := nil;
  end;
  if AExtension = '*' then
  begin
    AGraphicClass := nil;
  end;
end;

procedure TDelViewMainForm.IniRead;
begin
  with TIniFile.Create(AppIniName) do
  begin
    try
      Top   := ReadInteger('Window','Top',Top);
      Left  := ReadInteger('Window','Left',Left);
      Height:= ReadInteger('Window','Height',Height);
      Width := ReadInteger('Window','Width',Width);
      JpgQuality     := ReadInteger('Jpeg','JpgQuality',JpgQuality);
      JpgProgressive := ReadBool('Jpeg','JpgProgressive',JpgProgressive);
    finally
      Free;
    end;
  end;
end;

procedure TDelViewMainForm.IniWrite;
begin
  with TIniFile.Create(AppIniName) do
  begin
    try
      WriteInteger('Window','Top',Top);
      WriteInteger('Window','Left',Left);
      WriteInteger('Window','Height',Height);
      WriteInteger('Window','Width',Width);
      WriteInteger('Jpeg','JpgQuality',JpgQuality);
      WriteBool('Jpeg','JpgProgressive',JpgProgressive);
    finally
      Free;
    end;
  end;
end;

procedure TDelViewMainForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  IniWrite;
end;

procedure TDelViewMainForm.NextList;
begin
  if G_ListBox.Items.Count = 0 then exit;//List がカラ
  repeat
    if G_ListBox.ItemIndex =
      G_ListBox.Items.Count-1 then exit;//種切れ
    G_ListBox.ItemIndex :=
      G_ListBox.ItemIndex+1;//次の項目を選択
  until LoadImage(
    G_ListBox.Items[G_ListBox.ItemIndex]);//ロードされるまで
end;

procedure TDelViewMainForm.MainImageDblClick(Sender: TObject);
begin
  NextList;
end;

end.