【delphi开源代码栏目提醒】:网学会员为需要delphi开源代码的朋友们搜集整理了ImageFileSelect.pas相关资料，希望对各位网友有所帮助!

    unit ImageFileSelect;
    interface
    uses
      SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
      Forms, Dialogs, JPEG, StdCtrls, Buttons, ExtCtrls, FileCtrl,
      ComCtrls, ShellApi;
    type
       EPowerException = class(Exception)
    end;
    
    type
      TImageSelectForm = class(TForm)
        DriveComboBox1: TDriveComboBox;
        DirectoryListBox1: TDirectoryListBox;
        Panel1: TPanel;
        BitBtn1: TBitBtn;
        BitBtn2: TBitBtn;
        FileListBox1: TFileListBox;
        Image1: TImage;
        ImageSizeLabel: TLabel;
        procedure FileListBox1Click(Sender: TObject);
        procedure DriveComboBox1Click(Sender: TObject);
        procedure FormActivate(Sender: TObject);
        procedure CheckBox1Click(Sender: TObject);
        procedure DirectoryListBox1Change(Sender: TObject);
        procedure DirectoryListBox1Click(Sender: TObject);
        procedure FormCreate(Sender: TObject);
      private
         function DiskInDrive(Drive: Char): Boolean;
      public
         procedure Chargement(afichier : string);
      end;
    
      Function Power(X, N : real) : extended;
      Procedure FitRect(var ImageRect : Trect;     // 矩形结构定义
                      var ImageZoom : single;    // 放大系数
                      Wdest, Hdest,          // 图像的高和宽
                      Worig, Horig,          // 图像的高和宽的原点
                      aMargex, aMargey : integer;  // 图像的范围
                      bigger : boolean);
    
    var
      ImageSelectForm: TImageSelectForm;
    
    implementation
    
    {$R *.DFM}
    
    uses ImageProcessMainUnit;
    var
      flag1 : boolean;
    
    procedure TImageSelectForm.FormCreate(Sender: TObject);
    begin
      flag1 := true;
    end;
    
    function TImageSelectForm.DiskInDrive(Drive: Char): Boolean;
    var
      ErrorMode: word;
    begin
      if Drive in ['a'..'z'] then Dec(Drive, $20);  //大小字母适宜性
      ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
      try
        if DiskSize(Ord(Drive) - $40) = -1 then
          Result := False
        else
          Result := True;
      finally
        SetErrorMode(ErrorMode);
      end;
    end;
    // 选择图像并给出图像的简图和大小
    procedure TImageSelectForm.FileListBox1Click(Sender: TObject);
    begin
      IF filelistbox1.items.count < 1 then exit;
      IF filelistbox1.filename = '' then exit;
      chargement(filelistbox1.filename);
      ImageSizeLabel.caption := '图像尺寸'+inttostr(WillbeChangedBmp.Width) +'*' +Inttostr(WillbeChangedBmp.Height);
    end;
    
    Procedure TImageSelectForm.Chargement(afichier : string);
    const
      K = 152;
    Var
      fattr : integer;
      w0, h0 : single;
      w, h   : single;
      kk : single;
      ext : string;
    begin
      fattr := Filegetattr(afichier);
      if fattr and fareadonly > 0 then
        showmessage('文件 '+afichier+' 是只读文件. '
        +' 当保存文件时发生错误');
      image1.picture.assign(nil);
      ext := uppercase(Extractfileext(afichier));
      // 只能是Jpg 或 bmp类型文件
      try
        Image1.Picture.LoadFromFile(afichier);
      except
        on EInvalidGraphic do
        begin
          Image1.Picture.Graphic := nil;
          exit;
        end;
      end;
      w0 := Image1.picture.graphic.Width;
      h0 := Image1.picture.graphic.Height;
      WillbeChangedBmp.free;
      WillbeChangedBmp := Tbitmap.create;
      WillbeChangedBmp.Width  := Image1.picture.graphic.Width;
      WillbeChangedBmp.Height := Image1.picture.graphic.Height;
      WillbeChangedBmp.pixelformat := pf24bit;
      WillbeChangedBmp.canvas.draw(0,0,Image1.picture.graphic);
      w := w0;
      h := h0;
      IF (w0 > K) OR (h0 > K) then
      begin
        KK := K;
        IF w0 > h0 then
        begin
          w := kk;
          h := (kk * h0) / w0;
        end
        else
        begin
          h := kk;
          w := (kk*w0) / h0;
        end;
      end;
      Image1.Width  := Trunc(w);
      Image1.Height := Trunc(h);
      // 图像在区域中间
      Image1.left := (Panel1.Width  - Image1.Width ) div 2;
      Image1.top  := (Panel1.Height - Image1.Height) div 2;
    end;
    
    procedure TImageSelectForm.DirectoryListBox1Change(Sender: TObject);
    begin
      IF Diskindrive(Drivecombobox1.drive) = False Then
      Begin
        Showmessage('驱动设备没准备好');
        exit;
      end;
      Filelistbox1.Itemindex := 0;
      Filelistbox1click(sender);
      Filelistbox1.setfocus;
    end;
    
    procedure TImageSelectForm.DriveComboBox1Click(Sender: TObject);
    begin
     IF Diskindrive(Drivecombobox1.drive) = False Then
      Begin
        Showmessage('驱动设备没准备好');
        exit;
      end;
    end;
    
    procedure TImageSelectForm.FormActivate(Sender: TObject);
    begin
      image1.visible := true;
      if flag1 then
      begin
        if directoryexists(CurrentDir) then Directorylistbox1.directory := CurrentDir;
      end
      else
      begin
         if ImageSelectForm.filelistbox1.itemindex <  ImageSelectForm.filelistbox1.items.count-1 then
         ImageSelectForm.filelistbox1.itemindex :=  ImageSelectForm.filelistbox1.itemindex+1
        else messagebeep(1);
      end;
      if flag1 then if filelistbox1.items.count > 1 then Filelistbox1.Itemindex := 0;
      if filelistbox1.items.count > 1 then filelistbox1.topindex := filelistbox1.itemindex -1;
      Filelistbox1click(sender);
      Filelistbox1.setfocus;
      flag1 := false;
    end;
    
    function Power(X, N : real) : extended;
    var
      t : longint;
      r : real;
      isInteger : boolean;
    begin
       if N = 0 then begin result := 1.0;  exit;  end;
       if X = 1.0 then begin result := 1.0;  exit; end;
       if X = 0.0 then
       begin
         if N > 0.0 then
         begin
           result := 0.0;
           exit;
         end
         else
           raise EPowerException.Create('无限大数');
         end;
         if (X > 0) then
         try
           result := exp(N * ln(X));
           exit;
         except
           raise EPowerException.Create('溢出');
         end;
         try
           t := trunc(n);
           if (n - t) = 0 then isInteger := true else isInteger := False;
         except
             r := int(n);
           if (n - r) = 0 then
           begin
             isInteger := true;
             if frac(r/2) = 0.5 then t := 1 else t := 2;
           end
           else
           begin
             t := 0;
             isInteger := False;
           end;
        end;
        if isInteger then
        begin  {n 是整数}
          if odd(t) then {n 是奇数}
          try
            result := -exp(N * ln(-X));
            exit;
          except
            raise EPowerException.Create('溢出');
          end
          else         {n 是偶数}
          try
            result := exp(N * ln(-X));
            exit;
          except
            raise EPowerException.Create('溢出');
          end;
        end
      else
      raise EPowerException.Create('复杂结果');
    end;
    
    // 图像放入合适的矩形区域
    // 保留长宽比
    Procedure FitRect(var ImageRect : Trect;
                      var ImageZoom : single;
                      Wdest, Hdest,
                      Worig, Horig,
                      aMargex, aMargey : integer;
                      bigger : boolean);
                                         
    var
      kw, kh : single;
      wd, hd, wo, ho : single;
      w , h : integer;
    begin
      if (worig < 1) or (horig < 1) or (wdest < 1) or (hdest < 1) then
      begin
        ImageRect.left   := 0;      ImageRect.top    := 0;
        ImageRect.right  := 0;      ImageRect.bottom := 0;
        ImageZoom := 1;
        exit;
      end;
        if (bigger = false) and
         (worig <= wdest-amargex*2) and (horig <= hdest-amargey*2) then
      begin
        w := worig;
        h := horig;
        ImageZoom := 1;
      end
      else
      begin
        wd := wdest - amargex*2;
        hd := hdest - amargey*2;
        wo := worig;
        ho := horig;
        kw := wd / wo;
        kh := hd / ho;
        if kw < kh then ImageZoom := kw else ImageZoom := kh;
        w := round(wo*ImageZoom);  h := round(ho*ImageZoom);
      end;
      ImageRect := bounds((wdest-w) div 2, (hdest-h) div 2, w, h);
    end;
    
    procedure TImageSelectForm.CheckBox1Click(Sender: TObject);
    begin
      chargement(filelistbox1.filename);
    end;
    
    procedure TImageSelectForm.DirectoryListBox1Click(Sender: TObject);
    begin
      Directorylistbox1.opencurrent;
    end; 
    end.
    

上一篇：frmServer.frm
下一篇：全程领航顶级赛事，ARCFOX加速品牌向上