unitformview.pas

图象处理的一些相关内容 不是很难的,实现简单,希望对大家有帮助

unit UnitFormView;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls,jpeg, Menus, Registry, ToolWin, ImgList,UnitFormBrowse,UnitStructureStorageFile;

type
  TFormView = class(TForm)
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    MenuReturnBrowMode: TMenuItem;
    MenuExit: TMenuItem;
    MenuTool: TMenuItem;
    MenuSlide: TMenuItem;
    N3: TMenuItem;
    MenuSetWallPaperCenter: TMenuItem;
    MenuSetWallPaperTiled: TMenuItem;
    MenuSetWallPaperStretch: TMenuItem;
    Timer1: TTimer;
    MenuZoom: TMenuItem;
    MenuZoomIN: TMenuItem;
    MenuZoomOut: TMenuItem;
    ImageList1: TImageList;
    ScrollBox1: TScrollBox;
    Panel1: TPanel;
    Image1: TImage;
    ToolBar1: TToolBar;
    ToolButtonReturnBrowMode: TToolButton;
    ToolButtonPreImage: TToolButton;
    ToolButtonNextImage: TToolButton;
    ToolButtonZoomIn: TToolButton;
    ToolButtonZoomOut: TToolButton;
    ToolButtonZoomOrigin: TToolButton;
    ToolButton7: TToolButton;
    MenuFullScreen: TMenuItem;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    N2: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    MenuFirstPage: TMenuItem;
    MenuLastPage: TMenuItem;
    PopupMenu1: TPopupMenu;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    PopMenuSlide: TMenuItem;
    PopMenuSlideState: TMenuItem;
    N12: TMenuItem;
    PopMenuScreenState: TMenuItem;
    MenuSlideState: TMenuItem;
    N1: TMenuItem;
    HTML1: TMenuItem;
    N13: TMenuItem;
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Image1DblClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MenuExitClick(Sender: TObject);
    procedure MenuSlideClick(Sender: TObject);
//    procedure MenuSetWallPaperCenterClick(Sender: TObject);
    procedure MenuClickSetWallPaper(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure MenuZoomINClick(Sender: TObject);
    procedure MenuZoomOutClick(Sender: TObject);
    procedure MenuZoomClick(Sender: TObject);
    procedure ToolButtonReturnBrowModeClick(Sender: TObject);
    procedure ToolButtonPreImageClick(Sender: TObject);
    procedure ToolButtonNextImageClick(Sender: TObject);
    procedure ToolButtonZoomInClick(Sender: TObject);
    procedure ToolButtonZoomOutClick(Sender: TObject);
    procedure ToolButtonZoomOriginClick(Sender: TObject);
    procedure MenuFullScreenClick(Sender: TObject);
    procedure ToolButton7Click(Sender: TObject);
    procedure MenuFirstPageClick(Sender: TObject);
    procedure MenuLastPageClick(Sender: TObject);
    procedure ScrollBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PopMenuSlideStateClick(Sender: TObject);
    procedure PopMenuScreenStateClick(Sender: TObject);
    procedure MenuToolClick(Sender: TObject);
    procedure HTML1Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
  private
    ViewBmp:Tbitmap;
    ViewJpg:TJpegImage;
    WinDir:string;
    WallPaperFullName:string;

    ZoomI:integer;
    IsFullScreenMode:boolean;
    Procedure WMSysCommand(Var message : TWMSysCommand) ; Message WM_SYSCOMMAND ;

    { Private declarations }
  public
    procedure ShowHint;
    procedure ShowImageFit(IsOriginalSize:boolean;Zoom:real);overload;
    procedure ShowImageFit(ImageHeight,ImageWidth:integer); overload;
    procedure ShowNextImage;
    procedure ShowPreImage;
    procedure ShowFirstImage;
    procedure ShowLastImage;
    procedure SetWallPaper(const style:integer);

    procedure Slide; //幻灯片
    { Public declarations }
  end;

const

  WallPaperName='MyACDSeeWallPaper.bmp';
  Center=0;    //居中
  Tiled=1;     //平铺
  Stretch=2;   //拉伸
const
  Step=100;

const Zoom:array[1..15] of real=(0.05,0.07,0.1,0.15,0.2,0.3,0.5,0.7,1,1.5,2,3,5,7,10);

var
  FormView: TFormView;

implementation

{$R *.dfm}

procedure TFormView.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);

begin
  case key of
    VK_RIGHT:
      begin
        sendmessage(ScrollBox1.Handle,WM_HSCROLL,SB_LINERIGHT,0);
        exit;
      end;
    VK_LEFT:
      begin
        sendmessage(ScrollBox1.Handle,WM_HSCROLL,SB_LINELEFT,0);
        exit;
      end;
    VK_UP:
      begin
        sendmessage(ScrollBox1.Handle,WM_VSCROLL,SB_LINEUP,0);
        exit;
      end;
    VK_DOWN:
      begin
        sendmessage(ScrollBox1.Handle,WM_VSCROLL,SB_LINEDOWN,0);
        exit;
      end;
    VK_PRIOR:
      begin
        sendmessage(ScrollBox1.Handle,WM_VSCROLL,SB_PAGEUP,0);
        exit;
      end;
    VK_NEXT:
      begin
        sendmessage(ScrollBox1.Handle,WM_VSCROLL,SB_PAGEDOWN,0);
        exit;
      end;
    VK_RETURN:
      begin
        //MenuSlide.Checked:=false;
        timer1.Enabled:=false;


        if not FormBrowse.IsReadStructureStorageFileMode then
        begin
          FormBrowse.ListView1.ItemIndex:=ImageFileList.GetIndex;
          FormBrowse.Show;
          FormBrowse.ListView1.SetFocus;
        end
        else
          FormBrowse.Show;

        self.Hide;
        exit;
      end;

    VK_SPACE:
      begin
        ShowNextImage;
        ShowImageFit(true,1);
        exit;
      end;
    VK_BACK:
      begin
        ShowPreImage;
        ShowImageFit(true,1);
        exit;
      end;

    VK_ADD:  //小键盘的“+”，放大图片
    begin
      if MenuZoomIN.Enabled then
        MenuZoomINClick(nil);
      exit;
    end;

    VK_SUBTRACT:  //小键盘的“-”，缩小图片
    begin
      if MenuZoomOut.Enabled then
        MenuZoomOutClick(nil);
      exit;
    end;

    187:  //“+”，放大图片
    begin
      if MenuZoomIN.Enabled then
        MenuZoomINClick(nil);
      exit;
    end;
    189:   //“-”，缩小图片
    begin
      if MenuZoomOut.Enabled then
        MenuZoomOutClick(nil);
      exit;
    end;

    191:   // “/”，原始大小显示图片
    begin
      ShowImageFit(true,1);
    end;
    VK_ESCAPE:
    begin
      if (not IsFullScreenMode) then
      begin
        timer1.Enabled:=false;
        exit;
      end
      else
      begin

        //self.Visible:=false;
        //timer1.Enabled:=false;
        self.BorderStyle:=bsSizeable;
        self.Menu:=MainMenu1;
        ToolBar1.Visible:=true;
        StatusBar1.Visible:=true;
        ScrollBox1.Align:=alClient;

        ShowImageFit(true,1);
        ScrollBox1.HorzScrollBar.Visible:=true;
        ScrollBox1.VertScrollBar.Visible:=true;
        IsFullScreenMode:=false;
        exit;
      end;
    end;
    else
   //   showmessage(inttostr(key));
      exit;
  end;



end;

procedure TFormView.FormCreate(Sender: TObject);
var
  CharWinDir: array[0..255] of char;

begin
  ViewBmp:=Tbitmap.Create;
  ViewJpg:=TJpegImage.Create;

  GetWindowsDirectory(CharWinDir, 255); //取得windows目录
  WinDir:=string(CharWinDir);
  WallPaperFullName:=WinDir+'\'+ WallPaperName;

  ZoomI:=9;  //Zomm[9]=1;
  IsFullScreenMode:=false;

end;

procedure TFormView.FormDestroy(Sender: TObject);
begin
  if assigned(ViewBmp) then
  begin
    ViewBmp.Free;
    ViewBmp:=nil;
  end;
  if assigned(ViewJpg) then
  begin
    ViewJpg.Free;
    ViewJpg:=nil;
  end;


end;

procedure TFormView.Image1DblClick(Sender: TObject);
var
  key:word;
begin
  key:=VK_RETURN;
  FormKeyDown(self,Key, []);

//
end;

procedure TFormView.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  application.Terminate;
end;

procedure TFormView.MenuExitClick(Sender: TObject);
begin
  application.Terminate;
end;

procedure TFormView.WMSysCommand(var message: TWMSysCommand);
begin
  //拦截最小化消息，因为默认的情况下form2最小化后在桌面上
  //而非在任务栏上
  if ( Message.CmdType and $FFF0 = SC_MINIMIZE ) then
    application.Minimize
  else
  inherited;
end;

procedure TFormView.MenuSlideClick(Sender: TObject);
begin
//  MenuSlide.Checked:=not MenuSlide.Checked;
//  timer1.Enabled:=MenuSlide.Checked;

end;


procedure TFormView.SetWallPaper(const style: integer);
var
  MyReg:TRegistry;
  TileWallpaper:string;
  WallpaperStyle:string;
begin
  case style of
    Center:
    begin
      TileWallpaper:='0';
      WallpaperStyle:='0';
    end;
    Tiled:
    begin
      TileWallpaper:='1';
      WallpaperStyle:='0';
    end;
    Stretch:
    begin
      TileWallpaper:='0';
      WallpaperStyle:='2';
    end;

  end; //end case

    //对win.ini文件进行写操作
    WritePrivateProfileString('desktop', 'wallpaper',pchar(WallPaperFullName),pchar( string(WinDir)+'\win.ini') );

    MyReg:=TRegistry.Create;   //创建对象
    MyReg.RootKey:=HKEY_USERS;  //设置根键
    try
      if  MyReg.OpenKey('.DEFAULT\Control Panel\desktop',True) then   //打开分支
      MyReg.WriteString('wallpaper',WallPaperName);//对注册表进行写操作
      MyReg.WriteString('TileWallpaper',TileWallpaper);
      MyReg.WriteString('WallpaperStyle',WallpaperStyle);
    finally
      MyReg.Closekey; //将更改内容写入注册表并关闭
    end;
      MyReg.Free; //释放对象

    //调用Win32 API函数设置墙纸

     SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(WallPaperFullName), 0);

end;

procedure TFormView.MenuClickSetWallPaper(Sender: TObject);
begin

  if not (Sender is TMenuItem) then exit;
  try
    image1.Picture.SaveToFile(Windir+'\'+WallPaperName);
  except
    showmessage('设置墙纸发生错误！');
    exit;
  end;

  case TMenuItem(Sender).Tag of

    0:    //居中
    begin
      MenuSetWallPaperCenter.Checked:=true;
      MenuSetWallPaperTiled.Checked:=false;
      MenuSetWallPaperStretch.Checked:=false;
      SetWallPaper(Center);
    end;
    1:    //平铺
    begin
      MenuSetWallPaperCenter.Checked:=False;
      MenuSetWallPaperTiled.Checked:=true;
      MenuSetWallPaperStretch.Checked:=false;
      SetWallPaper(Tiled);
    end;
    2:    //拉伸
    begin
      MenuSetWallPaperCenter.Checked:=false;
      MenuSetWallPaperTiled.Checked:=false;
      MenuSetWallPaperStretch.Checked:=true;
      SetWallPaper(Stretch);
    end;

  end; //end case

end;

procedure TFormView.Timer1Timer(Sender: TObject);
//var
//  key:word;
begin
//  key:=VK_SPACE;
 // FormKeyDown(self,Key, []);
  slide;
//
end;

procedure TFormView.ShowImageFit(IsOriginalSize:boolean;Zoom:real);
begin
  panel1.Visible:=false;

  if IsOriginalSize then
  begin
    ZoomI:=9;
    Image1.AutoSize:=true;
    Image1.Stretch:=true;

    Panel1.Top:=0;
    Panel1.Left:=0;
    Panel1.Height:=Image1.Picture.Height;
    Panel1.Width:=Image1.Picture.width;
  end
  else
  begin
    Image1.Stretch:=true;

    Panel1.Top:=0;
    Panel1.Left:=0;
    //Panel1.Height:=Image1.Height;
    //Panel1.Width:=Image1.width;
    Panel1.Height:=trunc(Image1.Picture.Height*Zoom);
    Panel1.Width:=trunc(Image1.Picture.Width*zoom);
  end;

  Image1.AutoSize:=false;
  Image1.Stretch:=true;
  Image1.Height:=panel1.Height;
  image1.Width:=panel1.Width;


  if (Panel1.Height<=ScrollBox1.Height) and (Panel1.Width<=ScrollBox1.Width) then
  begin
    Panel1.Top:=(ScrollBox1.Height-Panel1.Height) div 2;
    Panel1.Left:=(ScrollBox1.Width-Panel1.Width) div 2;

    Image1.Top:=0;
    Image1.Left:=0;
    panel1.Visible:=true;
  end
  else
  begin
    if Panel1.Height>ScrollBox1.Height then
      Panel1.Top:=0
    else
      Panel1.Top:=(ScrollBox1.Height-Panel1.Height) div 2;

    if Panel1.Width>ScrollBox1.Width then
      Panel1.Left:=0
    else
      Panel1.Left:=(ScrollBox1.Width-Panel1.Width) div 2;

  end;

  panel1.Visible:=true;

  ShowHint;

//
end;

//放大
procedure TFormView.MenuZoomINClick(Sender: TObject);
begin
  inc(ZoomI);

  ShowImageFit(false,Zoom[ZoomI]);
  //1.5*7=1.5

  if ZoomI=15 then
  begin
    MenuZoomIN.Enabled:=false;
    ToolButtonZoomIn.Enabled:=false;
  end
  else if ZoomI>=2 then

  begin
    MenuZoomOut.Enabled:=true;
    ToolButtonZoomOut.Enabled:=true;
  end;



end;

//缩小
procedure TFormView.MenuZoomOutClick(Sender: TObject);
begin
  dec(ZoomI);
  ShowImageFit(false,Zoom[ZoomI]);

  if ZoomI=1 then
  begin
    MenuZoomOut.Enabled:=false;
    ToolButtonZoomOut.Enabled:=false;
  end
  else if ZoomI<=14 then
  begin
    MenuZoomIn.Enabled:=true;
    ToolButtonZoomIn.Enabled:=true;
  end;

end;

procedure TFormView.MenuZoomClick(Sender: TObject);
begin
  MenuZoomIN.Enabled:=not(image1.Height>trunc((image1.Picture.Bitmap.Height*7.5938)) );
  MenuZoomOut.Enabled:=not(image1.Height<trunc((image1.Picture.Bitmap.Height*0.1176)) );


end;

procedure TFormView.ToolButtonReturnBrowModeClick(Sender: TObject);
var
  key:word;
begin
  key:=VK_RETURN;
  FormKeyDown(self,Key, []);
end;

procedure TFormView.ShowNextImage;
var
  ImageFileName:string;

begin
  if not FormBrowse.IsReadStructureStorageFileMode then
  begin

    ImageFileName:=ImageFileList.GetNextFileName;

    if IsJpgFile(ImageFileName) then
    begin
      try
        JpgToBmp(ImageFileName,ViewJpg,ViewBmp);
        image1.Picture.Bitmap:=ViewBmp;
      except
        MessageDlg('读取文件：'+ImageFileName+'时发生错误！'+#13
        +'该文件不是标准格式的文件，或者该文件已经被损坏！',mtError,[mbYes],0);

        if ImageFileList.GetIndex=ImageFileList.GetFileCount-1 then
          ImageFileList.SetIndex(0)
        else
          ImageFileList.SetIndex(ImageFileList.GetIndex+1);
        exit;
      end;
    end
    else
      try
        image1.Picture.LoadFromFile(ImageFileName);
      except
        MessageDlg('读取文件：'+ImageFileName+'时发生错误！'+#13
        +'该文件不是标准格式的文件，或者该文件已经被损坏！',mtError,[mbYes],0);

        if ImageFileList.GetIndex=ImageFileList.GetFileCount-1 then
          ImageFileList.SetIndex(0)
        else
          ImageFileList.SetIndex(ImageFileList.GetIndex+1);

        exit;
      end;
  end
  else