⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 一个经典的图像浏览实例
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FileCtrl, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    refresh: TButton;
    DirectoryListBox1: TDirectoryListBox;
    FileListBox1: TFileListBox;
    DriveComboBox1: TDriveComboBox;
    FilterComboBox1: TFilterComboBox;
    selectall: TButton;
    rename: TButton;
    delete: TButton;
    ScrollBox1: TScrollBox;
    procedure selectallClick(Sender: TObject);
    procedure deleteClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure refreshClick(Sender: TObject);
    procedure renameClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure DirectoryListBox1Change(Sender: TObject);
    procedure FileListBox1DblClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit3;

{$R *.dfm}

var
  butter_bitmap:Tbitmap;

procedure TForm1.selectallClick(Sender: TObject);
begin
     FileListBox1.SelectAll;
end;

procedure TForm1.deleteClick(Sender: TObject);
var i:integer;
begin
     if Filelistbox1.SelCount<>0  then
        if  Filelistbox1.SelCount<>-1 then
        begin
            if filelistbox1.SelCount=1 then
            begin
               if MessageDlg('Delete file?',mtConfirmation,[mbyes,mbno],0)=mryes then
                 deletefile(filelistbox1.FileName);
            end
            else if Messagedlg('Delete all files?',mtConfirmation,[mbyes,mbno],0)=mryes then
                 for i:=0 to filelistbox1.Items.Count-1 do
                 begin
                      if filelistbox1.Selected[i] then
                      deletefile(filelistbox1.Directory+filelistbox1.Items.Strings[i]);
                 end;
        end;
     filelistbox1.Update;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
      FileListBox1.MultiSelect:=true;
      butter_bitmap:=Tbitmap.Create;
end;

procedure TForm1.refreshClick(Sender: TObject);
begin
     directorylistbox1.Update;
     filelistbox1.Update;
end;

procedure TForm1.renameClick(Sender: TObject);
begin
     if filelistbox1.SelCount>1 then
        messagedlg('Please select single file',mtwarning,[mbok],0)
     else
     begin
          if filelistbox1.FileName='' then
               messagedlg('Please select one Bmp file',mtwarning,[mbok],0)
          else
          begin
               form1.Enabled:=false;
               form2.show;
               form1.Enabled:=true;
          end;
     end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  messagedlg(inttostr(scrollbox1.ComponentCount),mtconfirmation,[mbok],0);
end;



procedure TForm1.DirectoryListBox1Change(Sender: TObject);
var
   templabel:Tlabel;
   temppic:Timage;
   i,px,lx,y:integer;
begin
   while scrollbox1.ComponentCount>0 do
     scrollbox1.Components[0].Free;
   lx:=132;
   px:=10;
   y:=10;
   for i:= 0 to filelistbox1.Count-1 do
   begin
      temppic:=Timage.create(self.ScrollBox1);
      temppic.Stretch:=true;
      temppic.Top:=px;
      temppic.Left:=y;
      temppic.Height:=120;
      temppic.Width:=160;
      temppic.Parent:=scrollbox1;
      temppic.Picture.LoadFromFile(filelistbox1.Directory+'\'+filelistbox1.Items.Strings[i]);
      temppic.Visible:=true;
      templabel:=Tlabel.Create(self.ScrollBox1);
      templabel.Parent:=scrollbox1;
      templabel.Top:=lx;
      templabel.Left:=y;
      templabel.Caption:=filelistbox1.Items.Strings[i];
      templabel.Visible:=true;
      inc(y,172);
      if y>400 then
      begin
         y:=10;
         inc(px,142);
         inc(lx,142);
      end;
   end;
end;

procedure TForm1.FileListBox1DblClick(Sender: TObject);
begin
  form1.Enabled:=false;
  form3.image.Picture.LoadFromFile(filelistbox1.FileName);
  form3.Show;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -