imagefm.pas

利用delphi编程工具编写的图片浏览工具

unit ImageFM;

interface

uses Windows, Classes, Graphics, Forms, Controls,
  FileCtrl, StdCtrls, ExtCtrls, Buttons, Spin, ComCtrls, Dialogs,Jpeg;

type
  TImageForm = class(TForm)
    DLBox: TDirectoryListBox;
    DCBox: TDriveComboBox;
    EdtFile: TEdit;
    GBUpDown: TGroupBox;
    SBtnEnable: TSpeedButton;
    BBtnEnable: TBitBtn;
    Panel1: TPanel;
    Image: TImage;
    FLBox: TFileListBox;
    Label2: TLabel;
    BtnView: TBitBtn;
    Bevel1: TBevel;
    Bevel2: TBevel;
    FCBox: TFilterComboBox;
    CBGlyph: TCheckBox;
    CBStretch: TCheckBox;
    EdtUpDown: TEdit;
    UpDown: TUpDown;
    DisabledGrp: TGroupBox;
    SBtnUnable: TSpeedButton;
    BBtnUnable: TBitBtn;
    procedure FLBoxClick(Sender: TObject);
    procedure BtnViewClick(Sender: TObject);
    procedure ViewAsGlyph(const FileExt: string);
    procedure CBGlyphClick(Sender: TObject);
    procedure CBStretchClick(Sender: TObject);
    procedure EdtFileKeyPress(Sender: TObject; var Key: Char);
    procedure EdtUpDownChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FormCaption: string;
  end;

var
  ImageForm: TImageForm;

implementation

uses ViewWin, SysUtils;

{$R *.dfm}

procedure TImageForm.FLBoxClick(Sender: TObject);
var
  FileExt: string[5];
begin
  FileExt := AnsiUpperCase(ExtractFileExt(FLBox.Filename));  //获取文件扩展名
  if (FileExt = '.BMP') or (FileExt = '.ICO')
      or (FileExt = '.JPEG') or (FileExt = '.JPG')then
  begin
    Image.Picture.LoadFromFile(FLBox.Filename);
    Caption := FormCaption + ExtractFilename(FLBox.Filename);
    if (FileExt = '.BMP')
    or (FileExt = '.JPEG') or (FileExt = '.JPG')then
    begin
      Caption := Caption +
        Format(' (%d x %d)', [Image.Picture.Width, Image.Picture.Height]);
      ViewForm.Image1.Picture := Image.Picture;
      ViewForm.Caption := Caption;
      if CBGlyph.Checked then ViewAsGlyph(FileExt);   //查看缩略图
    end
    else
      CBGlyph.Checked := False;

    if FileExt = '.ICO' then
    begin
      Icon := Image.Picture.Icon;
      ViewForm.Image1.Picture.Icon := Icon;
    end;
  end;

end;

procedure TImageForm.CBGlyphClick(Sender: TObject);
begin
  ViewAsGlyph(AnsiUpperCase(ExtractFileExt(FLBox.Filename)));
end;

procedure TImageForm.ViewAsGlyph(const FileExt: string);
begin
  if CBGlyph.Checked and (FileExt = '.BMP') then
  begin
    //设置位图按钮和加速按钮上的图片
    SBtnEnable.Glyph := Image.Picture.Bitmap;
    SBtnUnable.Glyph := Image.Picture.Bitmap;
    UpDown.Position := SBtnEnable.NumGlyphs;  //设置UpDown按钮的位置
    BBtnEnable.Glyph := Image.Picture.Bitmap;
    BBtnUnable.Glyph := Image.Picture.Bitmap;
  end
  else begin
    //设置图片为空
    SBtnEnable.Glyph := nil;
    SBtnUnable.Glyph := nil;
    BBtnEnable.Glyph := nil;
    BBtnUnable.Glyph := nil;
  end;
  UpDown.Enabled := CBGlyph.Checked;
  EdtUpDown.Enabled := CBGlyph.Checked;
  Label2.Enabled := CBGlyph.Checked;
end;

procedure TImageForm.BtnViewClick(Sender: TObject);
begin
  ViewForm.HorzScrollBar.Range := Image.Picture.Width;
  ViewForm.VertScrollBar.Range := Image.Picture.Height;
  ViewForm.Caption := Caption;
  ViewForm.Show;
  ViewForm.WindowState := wsNormal;
end;

procedure TImageForm.EdtUpDownChange(Sender: TObject);
var
   sMinValue,sMaxValue:string;
begin
  sMinValue := '所设的数太小';
  sMaxValue := '所设的数太大';
  if (StrToInt(EdtUpDown.Text) < UpDown.Min) then
  begin
    EdtUpDown.Text := '1';
    ShowMessage(sMinValue);
  end
  else if (StrToInt(EdtUpDown.Text) > UpDown.Max) then
  begin
    EdtUpDown.Text := '4';
    ShowMessage(sMaxValue);
  end;
  SBtnEnable.NumGlyphs := UpDown.Position;
  SBtnUnable.NumGlyphs := UpDown.Position;
end;

procedure TImageForm.CBStretchClick(Sender: TObject);
begin
  Image.Stretch := CBStretch.Checked;
end;

procedure TImageForm.EdtFileKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then //回车键
  begin
    FLBox.ApplyFilePath(EdtFile.Text);
    Key := #0;
  end;
end;

procedure TImageForm.FormCreate(Sender: TObject);
begin
  FormCaption := Caption + ' - ';   //图片浏览器 -
end;

end.