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

📄 unit1.pas

📁 家庭数字相册
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, ExtCtrls, ComCtrls, jpeg;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    btNext: TBitBtn;
    btPrior: TBitBtn;
    btAuto: TBitBtn;
    btLast: TBitBtn;
    btFirst: TBitBtn;
    btExit: TBitBtn;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Edit1: TEdit;
    btBrows: TSpeedButton;
    btAdd: TBitBtn;
    GroupBox3: TGroupBox;
    btDelete: TBitBtn;
    btDelAll: TBitBtn;
    Label2: TLabel;
    lbInfo: TLabel;
    btExit1: TBitBtn;
    Panel1: TPanel;
    Image1: TImage;
    OpenDialog1: TOpenDialog;
    Timer1: TTimer;
    GroupBox4: TGroupBox;
    Edit2: TEdit;
    UpDown1: TUpDown;
    Label4: TLabel;
    ListBox1: TListBox;
    procedure btBrowsClick(Sender: TObject);
    procedure btAddClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure btDeleteClick(Sender: TObject);
    procedure btDelAllClick(Sender: TObject);
    procedure btNextClick(Sender: TObject);
    procedure btPriorClick(Sender: TObject);
    procedure btLastClick(Sender: TObject);
    procedure btFirstClick(Sender: TObject);
    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
    procedure btAutoClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btBrowsClick(Sender: TObject);
begin
//选择单个或者多个图片文件
  if OpenDialog1.Execute then
    begin
      if OpenDialog1.Files.Count>1 then
        begin
          Edit1.Text:='多个文件';
        end
        else
          Edit1.Text:=OpenDialog1.FileName;
      btAdd.Enabled:=true;
    end;
end;

procedure TForm1.btAddClick(Sender: TObject);
begin
//向列表中添加选择的文件
  if OpenDialog1.Files.Count>1 then
    ListBox1.Items.AddStrings(OpenDialog1.Files);
  else
    ListBox1.Items.Add(Edit1.Text);
//列表已更新,重新设置显示位置
  ListBox1.ItemIndex:=0;
  Image1.Picture.LoadFromFile(ListBox1.Items.Strings[0]) ;
  btAdd.Enabled:=false;
  btNext.Enabled:=true;
  btLast.Enabled:=true;
  btAuto.Enabled:=true;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  if ListBox1.ItemIndex>-1 then
    lbInfo.Caption:=ListBox1.Items.Strings[ListBox1.ItemIndex]
   else
    lbInfo.Caption:='没有选择文件';
end;

procedure TForm1.btDeleteClick(Sender: TObject);
begin
//删除在列表中选择的文件
  if ListBox1.ItemIndex>-1 then
  begin
    ListBox1.Items.Delete(ListBox1.ItemIndex);
  end;
//如果列表中所有文件删除完毕,调用btDelAll来设置按钮及其控件属性
  if ListBox1.Items.Count=0 then
    btDelAll.Click;
end;

procedure TForm1.btDelAllClick(Sender: TObject);
begin
//删除列表中所有文件
  Timer1.Enabled:=false;
  btNext.Enabled:=false;
  btPrior.Enabled:=false;
  btLast.Enabled:=false;
  btFirst.Enabled:=false;
  btAuto.Enabled:=false;
  ListBox1.ItemIndex:=-1;
  ListBox1.Clear;
end;

procedure TForm1.btNextClick(Sender: TObject);
begin
  if (ListBox1.ItemIndex<ListBox1.Count-1) then
    begin
      ListBox1.ItemIndex:=ListBox1.ItemIndex+1;
      Image1.Picture.LoadFromFile(ListBox1.Items.Strings[ListBox1.ItemIndex]);
      if ListBox1.ItemIndex=ListBox1.Count-1 then	//已经到达列表最后一项
        begin
          btNext.Enabled:=false;
          btLast.Enabled:=false;
        end;
      btPrior.Enabled:=true;
      btFirst.Enabled:=true;
    end;
end;

procedure TForm1.btPriorClick(Sender: TObject);
begin
  if (ListBox1.ItemIndex>0) then
    begin
      ListBox1.ItemIndex:=ListBox1.ItemIndex-1;
      Image1.Picture.LoadFromFile(ListBox1.Items.Strings[ListBox1.ItemIndex]);
      if ListBox1.ItemIndex=0 then	//已经到达列表最前一项
        begin
          btPrior.Enabled:=false;
          btFirst.Enabled:=false;
        end;
      btNext.Enabled:=true;
      btLast.Enabled:=true;
    end;
end;

procedure TForm1.btLastClick(Sender: TObject);
begin
//直接显示列表最后一项
  ListBox1.ItemIndex:=ListBox1.Count-1;
  Image1.Picture.LoadFromFile(ListBox1.Items.Strings[ListBox1.ItemIndex]) ;
  btNext.Enabled:=false;
  btPrior.Enabled:=true;
  btLast.Enabled:=false;
  btFirst.Enabled:=true;
end;

procedure TForm1.btFirstClick(Sender: TObject);
begin
//直接显示列表最前一项
  ListBox1.ItemIndex:=0;
  Image1.Picture.LoadFromFile(ListBox1.Items.Strings[0]) ;
  btNext.Enabled:=true;
  btPrior.Enabled:=false;
  btLast.Enabled:=true;
  btFirst.Enabled:=false;
end;

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
//设置自动翻页时间间隔
  Timer1.Enabled:=false;
  Timer1.Interval:=strtoint(Edit2.Text)*1000;
end;

procedure TForm1.btAutoClick(Sender: TObject);
begin
//设置自动翻页
  if ListBox1.Count>0 then
    begin
      Timer1.Enabled:=not Timer1.Enabled;
      if Timer1.Enabled then
        btAuto.Caption:='停止翻页'
      else
        btAuto.Caption:='自动翻页';
    end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if btNext.Enabled then
    btNext.Click	//自动往下翻一页
  else
  begin
    //到了最后一页的时候重新从第一页开始显示
    ListBox1.ItemIndex:=0;
    Image1.Picture.LoadFromFile(ListBox1.Items.Strings[0]) ;
    btFirst.Enabled:=false;
    btPrior.Enabled:=false;
    btNext.Enabled:=true;
    btLast.Enabled:=true;
  end;
end;

procedure TForm1.btExitClick(Sender: TObject);
begin
  close;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  listfile:string;
begin
//自动加载列表文件
  listfile:=ExtractFilePath(Application.ExeName)+'pictures.lst';
  if FileExists(listfile) then	//列表文件如果存在则加载
    begin
      ListBox1.Items.LoadFromFile(listfile);
      if ListBox1.Items.Count>0 then
      begin
        ListBox1.ItemIndex:=0;
        Image1.Picture.LoadFromFile(ListBox1.Items.Strings[ListBox1.ItemIndex]) ;
      end
      else
        btDelAll.Click;	//调用目的仅为设置控件属性
    end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//自动保存列表文件
  ListBox1.Items.SaveToFile(ExtractFilePath(Application.ExeName)+'pictures.lst');
end;

end.

⌨️ 快捷键说明

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