unit1.pas

精彩编程百例26～50 其中有 控制任务栏 windows底层任务控制 屏保预览 特效窗体 文件关联操作等待！

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, FileCtrl, StdCtrls,Jpeg, Menus;
const maxshowbmpnum=8;
type
showarrayrecord=record
showimage:Timage;
backpanel:tpanel;
filename:string[15];
end;
  TForm1 = class(TForm)
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    FilterComboBox1: TFilterComboBox;
    FileListBox1: TFileListBox;
    Bevel1: TBevel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Image5: TImage;
    Image6: TImage;
    Image7: TImage;
    Image8: TImage;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FileListBox1Click(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure DirectoryListBox1Change(Sender: TObject);
    procedure DriveComboBox1Change(Sender: TObject);
    procedure Image2Click(Sender: TObject);
    procedure Image3Click(Sender: TObject);
    procedure Image4Click(Sender: TObject);
    procedure Image5Click(Sender: TObject);
    procedure Image6Click(Sender: TObject);
    procedure Image7Click(Sender: TObject);
    procedure Image8Click(Sender: TObject);
    procedure N2Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
    jpgimage:Tjpegimage;
    picturewidth,pictureheight,currentselectednum:integer;
    showbararray:array[1..maxshowbmpnum]of showarrayrecord;
    fileext:string[4];
    procedure initshowbararray;
    procedure unvisibleshowbar;
    procedure clearshowbarcolor;
    procedure setshowbarcolor(const currentselectednum:integer);
    procedure visibleshowbar(const endnum:integer);
    procedure updateshowbararray(var startnum:integer;const endnum:integer);
    procedure loadpicture(const filename:string;var destimage:Timage);
    procedure bigview(const currentclickednum:integer);
  end;



var
Form1: TForm1;
implementation
uses Unit2;

{$R *.DFM}
procedure TForm1.loadpicture(const filename:string;var destimage:timage);
//在面板上显示图片子程序
    begin
        fileext:=ansilowercase(extractfileext(filename));
        if fileext='.bmp' then
        begin
            destimage.picture.loadfromfile(filename);
            picturewidth:=destimage.picture.width;
            pictureheight:=destimage.picture.height;
        end
        else
        if fileext='.jpg' then
            begin
                jpgimage.loadfromfile(filename);
                destimage.picture.graphic:=jpgimage;
                picturewidth:=destimage.picture.width;
                pictureheight:=destimage.picture.height;
            end;
        end;

procedure TForm1.updateshowbararray(var startnum:integer;const endnum:integer);//更新面板上显示的图片
var
    i:integer;
    widthtimes,heighttimes,smalltimes:real;
begin
    i:=1;
    if startnum<=endnum-1 then
    begin
        while startnum<endnum do
        begin
            showbararray[i].filename:=filelistbox1.items[startnum];
loadpicture(directorylistbox1.directory+'\'+showbararray[i].filename,showbararray[i].showimage);
            widthtimes:=picturewidth/80;
            heighttimes:=pictureheight/60;
            if widthtimes>=heighttimes then
            smalltimes:=widthtimes
            else
            smalltimes:=heighttimes;
showbararray[i].showimage.width:=round(picturewidth/smalltimes);
showbararray[i].showimage.height:=round(pictureheight/smalltimes);
showbararray[i].showimage.left:=(showbararray[i].backpanel.width-showbararray[i].showimage.width)div 2;
showbararray[i].showimage.top:=(showbararray[i].backpanel.height-showbararray[i].showimage.height)div 2;
            inc(i);
            inc(startnum);
        end;
    end;
end;

procedure TForm1.unvisibleshowbar;//对不可见图象的处理
var
i:integer;
begin
    for i:=1 to maxshowbmpnum do
    begin
        showbararray[i].backpanel.visible:=false;
    end;
end;

procedure Tform1.initshowbararray;//控制面板上显示的图片
var
i:integer;
begin
    showbararray[1].showimage:=image1;
    showbararray[1].backpanel:=panel1;
    showbararray[2].showimage:=image2;
    showbararray[2].backpanel:=panel2;
    showbararray[3].showimage:=image3;
    showbararray[3].backpanel:=panel3;
    showbararray[4].showimage:=image4;
    showbararray[4].backpanel:=panel4;
    showbararray[5].showimage:=image5;
    showbararray[5].backpanel:=panel5;
    showbararray[6].showimage:=image6;
    showbararray[6].backpanel:=panel6;
    showbararray[7].showimage:=image7;
    showbararray[7].backpanel:=panel7;
    showbararray[8].showimage:=image8;
    showbararray[8].backpanel:=panel8;
    for i:=1 to maxshowbmpnum do
    begin
        showbararray[i].backpanel.caption:='';
    end;
end;

procedure Tform1.clearshowbarcolor;// 清除图片显示区的颜色
var
i:integer;
begin
    for i:=1 to maxshowbmpnum do
    begin
        showbararray[i].backpanel.color:=clBtnface;
    end;
end;

procedure Tform1.setshowbarcolor(const currentselectednum:integer); //设置选中图像的颜色
begin
    showbararray[currentselectednum].backpanel.color:=clblue;
end;

procedure Tform1.visibleshowbar(const endnum:integer);//对可见图象的处理
var
i:integer;
begin
    for i:=1 to endnum do
    showbararray[i].backpanel.visible:=true;
end;
procedure TForm1.bigview(const currentclickednum:integer);
var
isjpegoriconflag:boolean;
begin
    with bigform do
    begin
        isjpegoriconflag:=false;
fileext:=ansilowercase(extractfileext(showbararray[currentclickednum].filename));
picturewidth:=showbararray[currentclickednum].showimage.picture.width;
pictureheight:=showbararray[currentclickednum].showimage.picture.height;
        if (fileext='.jpg')or(fileext='.bmp')  then
        isjpegoriconflag:=true;
bigimage.picture:=showbararray[currentclickednum].showimage.picture;
        bigimage.width:=picturewidth;
        bigimage.height:=pictureheight;
            if(pictureheight>bigform.clientheight) and (picturewidth>bigform.clientwidth) then
            begin
                bigimage.top:=0;
                bigimage.left:=0;
            end
            else
            if pictureheight>bigform.clientheight then
            begin
                bigimage.top:=0;
                bigimage.left:=(bigform.clientwidth-picturewidth)div 2;
            end
            else
            if picturewidth>bigform.clientwidth then
            begin
                bigimage.top:=(bigform.clientheight-pictureheight)div 2;
                bigimage.left:=0;
            end
            else
            begin
                bigimage.top:=(bigform.clientheight-pictureheight)div 2;
                bigimage.left:=(bigform.clientwidth-picturewidth)div 2;
            end;
        color:=clblack;        caption:=directorylistbox1.directory+'\'+showbararray[currentclickednum].filename;
        show;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);//初始化窗体
begin
    jpgimage:=tjpegimage.create;
    picturewidth:=80;
    pictureheight:=60;
    initshowbararray;
    unvisibleshowbar;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    jpgimage.free;
end;

procedure TForm1.FileListBox1Click(Sender: TObject);//点击图象列表中图片
var
startshownum,endshownum:integer;
begin
    if filelistbox1.items.count<>0 then
    begin
        unvisibleshowbar;
        clearshowbarcolor;
        startshownum:=filelistbox1.itemindex;
        if filelistbox1.itemindex+maxshowbmpnum<=filelistbox1.items.count-1 then
        endshownum:=filelistbox1.itemindex+maxshowbmpnum
        else
        endshownum:=filelistbox1.items.count;
        currentselectednum:=1;
        setshowbarcolor(currentselectednum);
        updateshowbararray(startshownum,endshownum);
        visibleshowbar(endshownum-filelistbox1.itemindex);
    end;
end;

procedure TForm1.Image1Click(Sender: TObject);//点击图片观看原图
var
i:integer;
begin
    i:=1;
    currentselectednum:=1;
    while i<=maxshowbmpnum do
    begin
        if showbararray[i].showimage=(sender as Timage) then
        begin
            currentselectednum:=i;
            i:=i+maxshowbmpnum;
        end
        else
        i:=i+1;
    end;
    clearshowbarcolor;
    setshowbarcolor(currentselectednum);
    bigview(currentselectednum);
end;

procedure TForm1.Image2Click(Sender: TObject);//点击图片观看原图
var
i:integer;
begin
    i:=1;
    currentselectednum:=1;
    while i<=maxshowbmpnum do
    begin
        if showbararray[i].showimage=(sender as Timage) then
        begin
            currentselectednum:=i;
            i:=i+maxshowbmpnum;
        end
        else
        i:=i+1;
    end;
    clearshowbarcolor;
    setshowbarcolor(currentselectednum);
    bigview(currentselectednum);
end;

procedure TForm1.Image3Click(Sender: TObject);//点击图片观看原图
var
i:integer;
begin
    i:=1;
    currentselectednum:=1;
    while i<=maxshowbmpnum do
    begin
        if showbararray[i].showimage=(sender as Timage) then
        begin
            currentselectednum:=i;
            i:=i+maxshowbmpnum;
        end
        else
        i:=i+1;
    end;
    clearshowbarcolor;
    setshowbarcolor(currentselectednum);
    bigview(currentselectednum);
end;

procedure TForm1.Image4Click(Sender: TObject);//点击图片观看原图
var
i:integer;
begin
    i:=1;
    currentselectednum:=1;
    while i<=maxshowbmpnum do
    begin
        if showbararray[i].showimage=(sender as Timage) then
        begin
            currentselectednum:=i;
            i:=i+maxshowbmpnum;
        end
        else
        i:=i+1;
    end;
    clearshowbarcolor;
    setshowbarcolor(currentselectednum);
    bigview(currentselectednum);
end;

procedure TForm1.Image5Click(Sender: TObject);//点击图片观看原图
var
i:integer;
begin
    i:=1;
    currentselectednum:=1;
    while i<=maxshowbmpnum do
    begin
        if showbararray[i].showimage=(sender as Timage) then
        begin
            currentselectednum:=i;
            i:=i+maxshowbmpnum;
        end
        else
        i:=i+1;
    end;
    clearshowbarcolor;
    setshowbarcolor(currentselectednum);
    bigview(currentselectednum);
end;

procedure TForm1.Image6Click(Sender: TObject);//点击图片观看原图
var
i:integer;
begin
    i:=1;
    currentselectednum:=1;
    while i<=maxshowbmpnum do
    begin
        if showbararray[i].showimage=(sender as Timage) then
        begin
            currentselectednum:=i;
            i:=i+maxshowbmpnum;
        end
        else
        i:=i+1;
    end;
    clearshowbarcolor;
    setshowbarcolor(currentselectednum);
    bigview(currentselectednum);
end;

procedure TForm1.Image7Click(Sender: TObject);//点击图片观看原图
var
i:integer;
begin
    i:=1;
    currentselectednum:=1;
    while i<=maxshowbmpnum do
    begin
        if showbararray[i].showimage=(sender as Timage) then
        begin
            currentselectednum:=i;
            i:=i+maxshowbmpnum;
        end
        else
        i:=i+1;
    end;
    clearshowbarcolor;
    setshowbarcolor(currentselectednum);
    bigview(currentselectednum);
end;

procedure TForm1.Image8Click(Sender: TObject);//点击图片观看原图
var
i:integer;
begin
    i:=1;
    currentselectednum:=1;
    while i<=maxshowbmpnum do
    begin
        if showbararray[i].showimage=(sender as Timage) then
        begin
            currentselectednum:=i;
            i:=i+maxshowbmpnum;
        end
        else
        i:=i+1;
    end;
    clearshowbarcolor;
    setshowbarcolor(currentselectednum);
    bigview(currentselectednum);
end;


procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
    form1.FileListBox1.Directory:=form1.DirectoryListBox1.Directory;
end;

procedure TForm1.DriveComboBox1Change(Sender: TObject);//改变驱动器事件
begin
    form1.DirectoryListBox1.Drive:=form1.DriveComboBox1.Drive;
end;

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


end.