imageviewer.~pas

关于DEPHI7的学习资料

  if ShowBrowserMenu.Checked then
   begin
      BrowserView.Visible := True;
      ShowBrowserPopup.Checked := True;
   end
  else
    begin
      BrowserView.Visible := False;
      ShowBrowserPopup.Checked := False;
    end;
end;

procedure TImageViewForm.ShowStatusBarActionExecute(Sender: TObject);
begin
  if ShowStatusBarMenu.Checked then
   begin
      StatusBarView.Visible := True;
      ShowStatusBarPopup.Checked := True;
   end
  else
    begin
      StatusBarView.Visible := False;
      ShowStatusBarPopup.Checked := False;
    end;

end;

procedure TImageViewForm.FullDisplayActionExecute(Sender: TObject);
begin
//暂时保存当前位置和大小
WinWidth := ImageViewForm.Width;
WinHeight := ImageViewForm.Height;
WinLeft := ImageViewForm.Left;
WinTop := ImageViewForm.Top;
//隐藏工具栏、浏览区、状态栏、菜单等
ToolBarView.Visible := False;
BrowserView.Visible := False;
StatusBarView.Visible := False;
ShowBrowserMenu.Checked := False;
ShowToolbarMenu.Checked := False;
ShowStatusBarMenu.Checked := False;
ShowBrowserPopup.Checked := False;
ShowToolbarPopup.Checked := False;
ShowStatusBarPopup.Checked := False;
Splitter1.Visible := False;
setmenu(Self.Handle,HMENU(0));    //隐藏菜单
ShowMenuPopup.Checked := False;
ShowMenuMenu.Checked := False;
//最大化
ImageViewForm.BorderStyle := bsNone;
ImageViewForm.BorderIcons := [];
ImageViewForm.WindowState := wsMaximized;
ImageViewForm.Refresh;
end;

procedure TImageViewForm.ShowMenuPopupClick(Sender: TObject);
begin
  if ShowMenuPopup.Checked then
   begin
      setmenu(Handle,hm);           //恢复菜单
      ShowMenuMenu.Checked := True;
   end
  else
    begin
      setmenu(Self.Handle,HMENU(0));    //隐藏菜单
      ShowMenuMenu.Checked := False;
    end;
end;

procedure TImageViewForm.ShowMenuMenuClick(Sender: TObject);
begin
  if ShowMenuMenu.Checked then
   begin
      setmenu(Handle,hm);          //恢复菜单
      ShowMenuPopup.Checked := True;
   end
  else
    begin
      setmenu(Self.Handle,HMENU(0));    //隐藏菜单
      ShowMenuPopup.Checked := False;
    end;
end;

procedure TImageViewForm.ExitActionExecute(Sender: TObject);
begin
close;
end;

procedure TImageViewForm.ResetDisplayActionExecute(Sender: TObject);
begin
//恢复工具栏、浏览区、状态栏、菜单
ToolBarView.Visible := True;
BrowserView.Visible := True;
StatusBarView.Visible := True;
ShowBrowserMenu.Checked := True;
ShowToolbarMenu.Checked := True;
ShowStatusBarMenu.Checked := True;
ShowBrowserPopup.Checked := True;
ShowToolbarPopup.Checked := True;
ShowStatusBarPopup.Checked := True;
Splitter1.Visible := True;
setmenu(Handle,hm);          //恢复菜单
ShowMenuPopup.Checked := True;
ShowMenuMenu.Checked := True;
//还原显示
ImageViewForm.BorderStyle := bsSizeable;
ImageViewForm.BorderIcons := [biSystemMenu,biMinimize,biMaximize];
ImageViewForm.WindowState := wsNormal;
//还原窗口位置和大小
ImageViewForm.Width := WinWidth;
ImageViewForm.Height := WinHeight;
ImageViewForm.Left := WinLeft;
ImageViewForm.Top := WinTop;
//刷新显示
ImageViewForm.Refresh;
end;

procedure TImageViewForm.AboutActionExecute(Sender: TObject);
begin
AboutForm.Show;
end;

procedure TImageViewForm.PrintImgActionExecute(Sender: TObject);
var
tmpBitmap : TBitmap; 
begin
  inherited;
  if (Image1.Picture.Bitmap.HandleType = bmDib) then
    begin
      with Image1.Picture.Bitmap do
       begin
         Printer.BeginDoc;
         Printer.Canvas.StretchDraw(Canvas.ClipRect,Image1.Picture.Bitmap);
         Printer.EndDoc;
       end;
    end
  else
     {非DIB格式图像先复制一个为DIB再打印}
    try
      begin
      tmpBitmap := TBitmap.Create;
      Bitblt(Image1.Canvas.Handle,0,0,Image1.Picture.Width,Image1.Picture.Height,
      tmpBitmap.Canvas.Handle,0,0,srccopy);
      tmpBitmap.HandleType := bmDib;
      with Image1.Picture.Bitmap do
        begin
         Printer.BeginDoc;
         Printer.Canvas.StretchDraw(Canvas.ClipRect,tmpBitmap);
         Printer.EndDoc;
         tmpBitmap.Free;
        end;
      end;
     finally
     //显示无法打印信息
     ShowMessage('现在无法打印该图像!!!'+#13#10
         +'1、是否选择了图像文件?'+#13#10
         +'2、打印机是否处于联机状态？'+#13#10
         +'3、打印机出现意外错误?'+#13#10
         +'4、操作系统运行情况正常?');
    end;
end;

procedure TImageViewForm.PrinterSettingActionExecute(Sender: TObject);
begin
  PrinterSetupDialog1.Execute;
end;

procedure TImageViewForm.FileSaveAsActionExecute(Sender: TObject);
begin
if Image1.Picture.Width <> 0 then
  begin
  if SavePic.Execute then
    begin
     Image1.Picture.SaveToFile(SavePic.FileName);
    end;
  end;
end;

procedure TImageViewForm.SetAsWallPaperActionExecute(Sender: TObject);
var Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  with Reg do
    begin
      RootKey := HKey_Current_User;
      if OpenKey('Control Panel\Desktop',False) then
         begin
           WriteString('TileWallPaper','0'); //非平铺方式
           WriteString('Wallpaper',
            ExPandFileName(FileListBox1.Items[FileListBox1.ItemIndex])); //改变墙纸
           WriteString('WallpaperStyle','2'); //拉伸方式
         end
      else
         begin
           ShowMessage('无法将该图像设置为墙纸！');
         end;
      CloseKey;
      Free;
      //广播注册表改动的消息
      Systemparametersinfo(SPI_SETDESKWALLPAPER,0,Nil,SPIF_SENDCHANGE);
    end;
  end;

procedure TImageViewForm.SlideSettingActionExecute(Sender: TObject);
begin
  SlideSetForm.Show;
end;

procedure TImageViewForm.FileDelActionExecute(Sender: TObject);
begin
If MessageDlg('确定删除该文件吗？',mtConfirmation,[mbYes,mbNo],mryes) =mrYes then
 begin
   if DeleteFile(ExPandFileName(FileListBox1.Items[FileListBox1.ItemIndex]))=False then
      ShowMessage('该文件无法删除!');
 end;
end;

procedure TImageViewForm.Timer1Timer(Sender: TObject);
begin
if SetSlide.BackwardSlide then
   NextImgActionExecute(Sender)
else
   PrevImgActionExecute(Sender);
end;

procedure TImageViewForm.NextImgActionExecute(Sender: TObject);
begin
  if FileIndex = FileNum then
    begin
      if Circulation then
         FileIndex := 0
      else
         begin
         //不执行任何操作
         end;
    end
  else
    FileIndex := FileIndex + 1;
  FileListBox1.ItemIndex := FileIndex;
  Doload(ExPandFileName(FileListBox1.Items[FileListBox1.ItemIndex]));
end;

procedure TImageViewForm.PrevImgActionExecute(Sender: TObject);
begin
  if FileIndex = 0 then
    begin
      if Circulation then
         FileIndex := FileNum
      else
         begin
         //不执行任何操作
         end;
    end
  else
    FileIndex := FileIndex - 1;
  FileListBox1.ItemIndex := FileIndex;
  Doload(ExPandFileName(FileListBox1.Items[FileListBox1.ItemIndex]));
end;

procedure TImageViewForm.SlidingActionExecute(Sender: TObject);
begin
Timer1.Interval := SetSlide.SlideTimer * 1000;
if SlidingMenu.Checked then
   begin
     SlidingMenu.Checked := False;
     SlidingPopup.Checked := False;
   end
else
   begin
     SlidingMenu.Checked := True;
     SlidingPopup.Checked := True;
   end;
Timer1.Enabled := SlidingMenu.Checked;
end;

procedure TImageViewForm.FileListBox1Change(Sender: TObject);
begin
Doload(FileListBox1.FileName);
end;

procedure TImageViewForm.DirectoryListBox1Change(Sender: TObject);
begin
GetImgList(Sender);
Doload(FileListBox1.FileName);
end;

procedure TImageViewForm.LastImgToolBTNClick(Sender: TObject);
begin
FileIndex := FileNum;
FileListBox1.ItemIndex := FileIndex;
Doload(ExPandFileName(FileListBox1.Items[FileListBox1.ItemIndex]));
end;

procedure TImageViewForm.AutoScaleActionExecute(Sender: TObject);
begin
if CheckBox1.Checked then
   begin
     CheckBox1.Checked := False;
   end
else
   begin
     CheckBox1.Checked := True;
   end;
CheckBox1Click(Sender);
end;

procedure TImageViewForm.View1vs2ActionExecute(Sender: TObject);
begin
Image1.Width := Image1.Picture.Width div 2;
Image1.Height := Image1.Picture.Height div 2;
Image1.Stretch := True;
Image1.Repaint;
end;

procedure TImageViewForm.View1vs1ActionExecute(Sender: TObject);
begin
Image1.Width := Image1.Picture.Width;
Image1.Height := Image1.Picture.Height;
Image1.Stretch := True;
Image1.Repaint;
end;

procedure TImageViewForm.View2vs1ActionExecute(Sender: TObject);
begin
Image1.Width := Image1.Picture.Width * 2;
Image1.Height := Image1.Picture.Height * 2;
Image1.Stretch := True;
Image1.Repaint;
end;

procedure TImageViewForm.ZoomInActionExecute(Sender: TObject);
begin
Image1.Width := Image1.Width * 2;
Image1.Height := Image1.Height * 2;
Image1.Stretch := True;
Image1.Repaint;
end;

procedure TImageViewForm.ZoomOutActionExecute(Sender: TObject);
begin
Image1.Width := Image1.Width div 2;
Image1.Height := Image1.Height div 2;
Image1.Stretch := True;
Image1.Repaint;
end;

procedure TImageViewForm.ImgCtrlLabelMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
  begin
    Origin.x := X;
    Origin.y := Y;
    ImageLeft := Image1.Left;
    ImageTop := Image1.Top;
    Visa1.x := X- (Image1.Width - Panel3.Width + Image1.Left);
    Visa1.y := Y- (Image1.Height - Panel3.Height + Image1.Top);
    Visa2.x := X- Image1.Left;
    Visa2.y := Y- Image1.Top;
    Canmove := True;
  end;
end;

procedure TImageViewForm.ImgCtrlLabelMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
if Canmove then
  begin
    if X < Visa1.x then X := Visa1.x;
    if X > Visa2.x then X := Visa2.x;
    if Y < Visa1.y then Y := Visa1.y;
    if Y > Visa2.y then Y := Visa2.y;
    Image1.Left := ImageLeft + (X - Origin.x);
    Image1.Top := ImageTop + (Y - Origin.y);
  end;
end;

procedure TImageViewForm.ImgCtrlLabelMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Canmove := False;
end;

procedure TImageViewForm.FormResize(Sender: TObject);
begin
  Image1.Width :=  Panel3.Width;
  Image1.Height := Panel3.Height;
end;

procedure TImageViewForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if Key in [VK_UP, VK_PRIOR, VK_LEFT] then PrevImgActionExecute(Sender)
else if Key in [VK_DOWN, VK_NEXT, VK_RIGHT] then NextImgActionExecute(Sender)
else if Key in [VK_END] then LastImgToolBTNClick(Sender);
//else if Key in [VK_HOME] then FirstImgActionExecute(Sender) ;
end;

end.