unit1.~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 tempClick(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;


type
Tmydefine=class(Tcustomcontrol)
fpic:Tbitmap;
private
   procedure setpic(value:Tbitmap);
public
   constructor create(Aowner:Tcomponent);override;
   destructor destroy;override;
   procedure paint;override;
published
   property pic:Tbitmap write setpic;
end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit3;

{$R *.dfm}

var
  butter_bitmap:Tbitmap;
  loop:Tmydefine;

procedure Tmydefine.setpic(value:Tbitmap);
begin
   fpic.Assign(value);
end;

constructor Tmydefine.create(Aowner:Tcomponent);
begin
   inherited create(Aowner);
   fpic:=Tbitmap.create;
end;

destructor Tmydefine.destroy;
begin
   fpic.Free;
   inherited destroy;
end;

procedure Tmydefine.paint;
var
   arect:trect;
begin
   arect:=clientrect;
   canvas.StretchDraw(arect,fpic);
   frame3d(canvas,arect,clblack,clwhite,2);
end;




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;
      loop:=Tmydefine.create(self);
      butter_bitmap:=Tbitmap.Create;
end;

procedure TForm1.tempClick(Sender: TObject);
var
   templabel:Tlabel;
   temppic:Tmydefine;
   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
      //messagedlg(filelistbox1.Directory+'\'+filelistbox1.Items.Strings[i],mtconfirmation,[mbok],0);
      butter_bitmap.LoadFromFile(filelistbox1.Directory+'\'+filelistbox1.Items.Strings[i]);
      temppic:=Tmydefine.create(self.ScrollBox1);
      temppic.Caption:=inttostr(i);
      temppic.Top:=px;
      temppic.Left:=y;
      temppic.Height:=120;
      temppic.Width:=160;
      temppic.Parent:=scrollbox1;
      temppic.pic:=butter_bitmap;
      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.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:Tmydefine;
   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
      butter_bitmap.LoadFromFile(filelistbox1.Directory+'\'+filelistbox1.Items.Strings[i]);
      temppic:=Tmydefine.create(self.ScrollBox1);
      temppic.Caption:=inttostr(i);
      temppic.Top:=px;
      temppic.Left:=y;
      temppic.Height:=120;
      temppic.Width:=160;
      temppic.Parent:=scrollbox1;
      temppic.pic:=butter_bitmap;
      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.