unit1.pas

一个看图程序 一个看图程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, Outline, DirOutln, StdCtrls, FileCtrl, ExtCtrls, Buttons, ComCtrls,
  Menus, Gauges, ImgList, ExtDlgs,JPEG;

type
  TImageView = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    DCB: TDriveComboBox;
    Panel4: TPanel;
    DOT: TDirectoryOutline;
    Panel5: TPanel;
    SB: TScrollBox;
    FB: TFileListBox;
    FCB: TFilterComboBox;
    Panel6: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    ImgBig: TImage;
    Panel9: TPanel;
    CB: TCheckBox;
    CB1: TCheckBox;
    Gauge1: TGauge;
    Panel10: TPanel;
    PopM: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    ImageList1: TImageList;
    N3: TMenuItem;
    CB2: TCheckBox;
    CB3: TCheckBox;
    N6: TMenuItem;
    TabSheet3: TTabSheet;
    Memo1: TMemo;
    procedure DCBChange(Sender: TObject);
    procedure DOTChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FCBChange(Sender: TObject);
    procedure Panel7MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel7MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel7Click(Sender: TObject);
    procedure SBMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SBClick(Sender: TObject);
    procedure CBClick(Sender: TObject);
    procedure CB1Click(Sender: TObject);
    procedure SBDblClick(Sender: TObject);
    procedure Panel10MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel10MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImgBigDblClick(Sender: TObject);
    procedure Panel10Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure CB2Click(Sender: TObject);
    procedure CB3Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure Memo1Click(Sender: TObject);
  private
    { Private declarations }
    procedure ShowImage;
    function JpgToBmp(Jpg: TJpegImage): TBitmap;
  public
    { Public declarations }
  end;

var
  ImageView: TImageView;
  Img:array[0..1000] of TImage;
  Nam:array[0..1000] of TLabel;
  Red:array[0..1000] of TPanel;
  Bak:array[0..1000] of TPanel;
  i,ImgPos,NamPos,NamPosOld:integer;
  Path:string;
implementation

uses Unit2, Unit3, Unit4;

{$R *.DFM}
procedure TImageView.DCBChange(Sender: TObject);
begin
  DOT.Drive:=DCB.Drive;
end;

procedure TImageView.DOTChange(Sender: TObject);
begin
  ShowImage;
end;

procedure TImageView.FormCreate(Sender: TObject);
begin
  NamPosOld:=1;
  i:=1;
end;

procedure TImageView.FCBChange(Sender: TObject);
begin
  FB.Mask:=FCB.Mask;
  ShowImage;
end;

procedure TImageView.ShowImage;
var j,k:integer;
var FileStream:TFileStream;
var AJpeg:TJpegImage;
begin
  if i>=1 then
    for j:=1 to i do
      begin
        if Assigned(Img[j]) then
          begin
            Img[j].Free;
            Img[j]:=nil;
          end;
        if Assigned(Nam[j]) then
          begin
            Nam[j].Free;
            Nam[j]:=nil;
          end;
        if Assigned(Bak[j]) then
          begin
            Bak[j].Free;
            Bak[j]:=nil;
          end;
        if Assigned(Red[j]) then
          begin
            Red[j].Free;
            Red[j]:=nil;
          end;
      end;
  Panel8.Caption:='';
  ImgBig.Picture:=nil;
  FB.Directory:=DOT.Directory;
  Panel6.Caption:='共'+inttostr(FB.Items.Count)+'张图片';
  GauGe1.MaxValue:=FB.Items.Count;
  for i:=1 to FB.Items.Count do
    begin
      Img[i]:=TImage.Create(self);
      if CB1.Checked then
        Img[i].Stretch:=True
      else
        Img[i].Stretch:=False;
      Nam[i]:=TLabel.Create(self);
      Nam[i].Font.Color:=clBlue;
      Red[i]:=TPanel.Create(self);
      Bak[i]:=TPanel.Create(self);
      Img[i].Parent:=Red[i];
      Nam[i].Parent:=Bak[i];
      Bak[i].Parent:=Red[i];
      Bak[i].BevelOuter:=bvLowered;
      Bak[i].Font.Size:=9;
      Bak[i].Font.Color:=clBlue;
      Red[i].Parent:=SB;
      Red[i].Visible:=True;
      Red[i].Width:=104;
      Red[i].Height:=118;
      Nam[i].Width:=100;
      Img[i].Width:=98;
      Img[i].Height:=98;
      Bak[i].Width:=100;
      Bak[i].Height:=12;
      Path:=FB.Directory+'\'+FB.Items.Strings[i-1];
      if Copy(Path,(Length(Path)-3),3)='Jpg' then
        begin
          AJpeg:=TJpegImage.Create;
          Img[i].Picture.Bitmap:=JpgToBmp(AJpeg);
          Img[i].Center:=True;
          AJpeg.Free;
        end
      else
        begin
          Img[i].Picture.LoadFromFile(Path);
          Img[i].Center:=True;
        end;
      if CB3.Checked then
        begin
          FileStream:=TFileStream.Create(FB.Items.Strings[i-1],fmOpenRead);
          Img[i].ShowHint:=True;
          Img[i].Hint:=inttostr(FileStream.Size)+' Bytes';
          FileStream.Free;
        end;
      if CB2.Checked then
        Img[i].PopupMenu:=PopM;
      Nam[i].Caption:=FB.Items.Strings[i-1];
      Bak[i].OnMouseMove:=SB.OnMouseMove;
      Bak[i].OnClick:=SB.OnClick;
      Bak[i].OnDblClick:=SB.OnDblClick;
      Img[i].OnMouseMove:=SB.OnMouseMove;
      Img[i].OnClick:=SB.OnClick;
      Img[i].OnDblClick:=SB.OnDblClick;
      if (i>=1) and (i<=5) then
        begin
          if (i=1) then
            begin
              Red[i].Top:=10;
              Red[i].Left:=10;
              Img[i].Top:=3;
              Img[i].Left:=3;
              Img[i].Visible:=True;
            end;
          if (i>=2) and (i<=5) then
            begin
              Red[i].Top:=Red[i-1].Top;
              Red[i].Left:=Red[i-1].Left+110;
              Img[i].Top:=3;
              Img[i].Left:=3;
              Img[i].Visible:=True;
            end;
        end
      else
        begin
          k:=Trunc(i/5);
          if ((i mod (k*5))=1) then
            begin
              if k=1 then
                Red[i].Top:=110*k+20
              else
                Red[i].Top:=120*k+10;
              Red[i].Left:=10;
              Img[i].Top:=3;
              Img[i].Left:=3;
              Img[i].Visible:=True;
            end
         else
            begin
              Red[i].Top:=Red[i-1].Top;
              Red[i].Left:=Red[i-1].Left+110;
              Img[i].Top:=3;
              Img[i].Left:=3;
              Img[i].Visible:=True;
            end;
        end;
      Bak[i].Top:=Img[i].Top+101;
      Bak[i].Left:=2;
      Bak[i].Caption:=inttostr(Img[i].Picture.Width)+'x'+inttostr(Img[i].Picture.Height);
      Nam[i].Visible:=False;
      Gauge1.Progress:=i;
    end;
end;


procedure TImageView.Panel7MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Panel7.BevelOuter:=bvLowered;
end;

procedure TImageView.Panel7MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Panel7.BevelOuter:=bvRaised;
end;

procedure TImageView.Panel7Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TImageView.SBMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  ImgPos:=0;
  for ImgPos:=1 to FB.Items.Count do
    if ((sender=Img[ImgPos]) or (sender=Nam[ImgPos])) then
      NamPos:=ImgPos;
end;

procedure TImageView.SBClick(Sender: TObject);
begin
  if ((sender is TImage) or (sender is TLabel)) then
  if NamPos<>NamPosOld then
    begin
      Panel8.Caption:=DOT.Directory+'\'+FB.Items[NamPos-1];
      Bak[NamPosOld].Font.Color:=clBlue;
      Bak[NamPos].Font.Color:=clGreen;
      Red[NamPosOld].Color:=clBtnFace;
      Red[NamPos].Color:=clRed;
      ImgBig.Picture:=Img[NamPos].Picture;
      NamPosOld:=NamPos;
    end;
end;

procedure TImageView.CBClick(Sender: TObject);
begin
  if CB.Checked then
    ImgBig.Stretch:=True
  else
    ImgBig.Stretch:=False;
end;

procedure TImageView.CB1Click(Sender: TObject);
begin
  ShowImage;
end;

procedure TImageView.SBDblClick(Sender: TObject);
begin
  if ((sender is TImage) or (sender is TLabel)) then
    begin
      FullSize.BorderIcons:=[biSystemMenu,biMinimize,biMaximize];
      FullSize.BorderStyle:=bsSizeable;
      FullSize.WindowState:=wsNormal;
      FullSize.Position:=poScreenCenter;
      FullSize.ImgFull.Picture:=Img[NamPos].Picture;
      FullSize.Width:=FullSize.ImgFull.Width+10;
      FullSize.Height:=FullSize.ImgFull.Height+30;
      FullSize.ShowModal;
    end;
end;

procedure TImageView.Panel10MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   Panel10.BevelOuter:=bvLowered;
end;

procedure TImageView.Panel10MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Panel10.BevelOuter:=bvRaised;
end;

procedure TImageView.ImgBigDblClick(Sender: TObject);
begin
  FullSize.ImgFull.Picture:=Img[NamPos].Picture;
  FullSize.ShowModal;
end;

procedure TImageView.Panel10Click(Sender: TObject);
begin
  AboutBox.ShowModal;
end;

procedure TImageView.N1Click(Sender: TObject);
begin
  CB1.Checked:=True;
  CB1.OnClick(self);
end;

procedure TImageView.N2Click(Sender: TObject);
begin
  CB1.Checked:=False;
  CB1.OnClick(self);
end;

procedure TImageView.N4Click(Sender: TObject);
begin
  FB.Mask:=FCB.Mask;
  ShowImage;
end;

procedure TImageView.N5Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TImageView.CB2Click(Sender: TObject);
begin
  ShowImage;
end;

procedure TImageView.CB3Click(Sender: TObject);
begin
  ShowImage;
end;

function TImageView.JpgToBmp(Jpg: TJpegImage): TBitmap;
begin
  Result := nil;
  if Assigned(Jpg) then
    begin
      Result := TBitmap.Create;
      Jpg.DIBNeeded;
      Result.Assign(Jpg);
    end;
end;

procedure TImageView.N6Click(Sender: TObject);
var THEPCHAR:pchar;
begin
THEPCHAR:=Pchar(Panel8.Caption);
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, THEPCHAR, 0);
end;
procedure TImageView.Memo1Click(Sender: TObject);
begin
  Memo1.Perform(EM_SCROLLCARET, 1, 1 );
end;

end.