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

📄 imageviewerf.pas

📁 极具实用价值的文件管理系统
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{ *********************************************************************** }
{ Unit Name: ImageViewerF
{ Purpose: Image Viewer
{ Author: Cyclone
{ History:
{         2004-7-22 0:02:42 Create the function
{         2005-03-07 00:06:22 Add Auto Advance function
{                             Add Zoom image by any scale function
{ *********************************************************************** }

unit ImageViewerF;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, BaseF, ComCtrls, ToolWin, ImgList, Menus, ActnList, ExtCtrls,
  PubFuns, ShellApi, StdCtrls, CycLabel, CycEdit, CycMemo, GR32_Image,
  GR32_Layers;

const
  XInterval = 10;
  YInterval = 10;

type
  TDirection = (dtUp, dtDown, dtLeft, dtRight);

  TfmImageViewer = class(TfmBase)
    ActionList1: TActionList;
    actePdmHelp: TAction;
    actePdmHomePage: TAction;
    actSupportOnLine: TAction;
    actAbout: TAction;
    mnuMain: TMainMenu;
    File1: TMenuItem;
    ImportFromFolder1: TMenuItem;
    ExportToFolder1: TMenuItem;
    N3: TMenuItem;
    Exit1: TMenuItem;
    Edit1: TMenuItem;
    actAddDirectory1: TMenuItem;
    actEditDirectory1: TMenuItem;
    actDeleteDirectory1: TMenuItem;
    Document1: TMenuItem;
    actAddDocument1: TMenuItem;
    actEditDocument1: TMenuItem;
    actDeleteDocument1: TMenuItem;
    View1: TMenuItem;
    Icon2: TMenuItem;
    SmallIcon2: TMenuItem;
    Help1: TMenuItem;
    ePdmHelp1: TMenuItem;
    ePdmHomePage1: TMenuItem;
    SupportOnLine1: TMenuItem;
    N1: TMenuItem;
    About1: TMenuItem;
    mnuViewStyle: TPopupMenu;
    ImgActionList: TImageList;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    pnlInformation: TPanel;
    SptWidth: TSplitter;
    pnlPreview: TPanel;
    StatusBar: TStatusBar;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    ToolButton18: TToolButton;
    ToolButton19: TToolButton;
    actBrowse: TAction;
    actSaveAs: TAction;
    actPrint: TAction;
    actFirst: TAction;
    actPrevious: TAction;
    actNext: TAction;
    actLast: TAction;
    actRotateLeft: TAction;
    actRotateRight: TAction;
    actZoomIn: TAction;
    actZoomOut: TAction;
    actFitWidth: TAction;
    actFitHeight: TAction;
    actAutoFit: TAction;
    actViewInformation: TAction;
    Last1: TMenuItem;
    FitWidth1: TMenuItem;
    FitHeight1: TMenuItem;
    AutoFilt1: TMenuItem;
    N5: TMenuItem;
    ViewInformation1: TMenuItem;
    ToolButton20: TToolButton;
    SaveDialog: TSaveDialog;
    Timer: TTimer;
    lblDocNo: TCycLabel;
    lblDocType: TCycLabel;
    lblDocName: TCycLabel;
    lblFileName: TCycLabel;
    lblVersion: TCycLabel;
    lblRemarks: TCycLabel;
    edtDocNo: TCycEdit;
    edtDocType: TCycEdit;
    edtDocName: TCycEdit;
    edtFileName: TCycEdit;
    edtVersion: TCycEdit;
    edtRemarks: TCycMemo;
    cbxZoomTo: TComboBox;
    actZoomTo: TAction;
    ToolButton21: TToolButton;
    ToolButton22: TToolButton;
    actAutoAdvance: TAction;
    TimAutoAdvance: TTimer;
    imgPreview: TImage32;
    imgFolder: TImage;
    ToolButton23: TToolButton;
    imgWarning: TImage;
    procedure actBrowseExecute(Sender: TObject);
    procedure SptWidthMoved(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure actViewInformationExecute(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure actFitWidthExecute(Sender: TObject);
    procedure actFitHeightExecute(Sender: TObject);
    procedure actAutoFitExecute(Sender: TObject);
    procedure actSaveAsExecute(Sender: TObject);
    procedure actPrintExecute(Sender: TObject);
    procedure actZoomOutExecute(Sender: TObject);
    procedure actZoomInExecute(Sender: TObject);
    procedure actFirstExecute(Sender: TObject);
    procedure actPreviousExecute(Sender: TObject);
    procedure actNextExecute(Sender: TObject);
    procedure actLastExecute(Sender: TObject);
    procedure actRotateLeftExecute(Sender: TObject);
    procedure actRotateRightExecute(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure actAboutExecute(Sender: TObject);
    procedure pnlInformationResize(Sender: TObject);
    procedure cbxZoomToClick(Sender: TObject);
    procedure actZoomToExecute(Sender: TObject);
    procedure cbxZoomToKeyPress(Sender: TObject; var Key: Char);
    procedure actAutoAdvanceExecute(Sender: TObject);
    procedure TimAutoAdvanceTimer(Sender: TObject);
    procedure imgPreviewDblClick(Sender: TObject);
    procedure imgPreviewMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure imgPreviewMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer; Layer: TCustomLayer);
    procedure imgPreviewMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  private
    { Private declarations }
    IsMoving: Boolean;
    IsAutoFit: Boolean;
    OriginalPos: TPoint;
    CurrentRelativeIndex: Integer;
    IndexArray: array of Integer;
    HistoryFileNameList: TStringList;
    procedure LoadFile(ListItem: TListItem);
    procedure InitFitStatus;
    procedure AutoFitImage;
    procedure RefreshNavigateButton;
    procedure RefreshInformation(AItem: TListItem);
    procedure InitIndexArray;
    function GetAbsoluteIndex(const RelativeIndex: Integer): Integer;
    function GetRelativeIndex(const AbsoluteIndex: Integer): Integer;
    procedure ShellOpenFile(AItem: TListItem);
    procedure MoveImage(const Direction: TDirection);
    procedure RefreshStatusBar(AItem: TListItem);
    procedure SetShowInformation(const ShowInformation: Boolean);
  public
    { Public declarations }
    ImageList: TListView;
    CurrentAbsoluteIndex: Integer;
    procedure OnSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
  end;

var
  fmImageViewer: TfmImageViewer;

implementation

uses AboutF, PrintF;

{$R *.dfm}

procedure TfmImageViewer.actBrowseExecute(Sender: TObject);
begin
  Close;
end;

{-----------------------------------------------------------------------------
  Procedure: LoadFile
  Purpose:   Load File
  Arguments: ListItem: TListItem
  Result:    None
  Author:    Cyclone
  History:   2004-7-21 23:36:36

-----------------------------------------------------------------------------}
procedure TfmImageViewer.LoadFile(ListItem: TListItem);
begin
  DeleteHistoryFiles(HistoryFileNameList);
  RefreshInformation(ListItem);
  IsAutoFit := IsImage(ListItem);
  DrawFile(pnlPreview, imgPreview, imgFolder, imgWarning, PListItemObj(ListItem.Data));
  AutoFitImage;
end;

procedure TfmImageViewer.SptWidthMoved(Sender: TObject);
begin
  AutoFitImage;
end;

procedure TfmImageViewer.FormActivate(Sender: TObject);
begin
  inherited;
  InitIndexArray;
  CurrentRelativeIndex := GetRelativeIndex(CurrentAbsoluteIndex);
  RefreshNavigateButton;
  InitFitStatus;
  actAutoFit.Checked := True;
  LoadFile(ImageList.Selected);
  RefreshStatusBar(ImageList.Items[CurrentAbsoluteIndex]);
end;

procedure TfmImageViewer.actViewInformationExecute(Sender: TObject);
begin
  actViewInformation.Checked := not actViewInformation.Checked;
  SetShowInformation(actViewInformation.Checked);
  AutoFitImage;
end;

procedure TfmImageViewer.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_RETURN:   begin
                   if (StrToIntDef(cbxZoomTo.Text, 0) <> 0) and (Round(imgPreview.Height / imgPreview.Bitmap.Height * 100) <> StrToInt(cbxZoomTo.Text)) then
                     actZoomTo.Execute
                   else
                     actBrowse.Execute;
                 end;
    VK_PRIOR:    actPrevious.Execute;
    VK_NEXT:     actNext.Execute;
    VK_HOME:     actFirst.Execute;
    VK_END:      actLast.Execute;
    187,
    VK_ADD:      actZoomIn.Execute;
    189,
    VK_SUBTRACT: actZoomOut.Execute;
    VK_UP:       MoveImage(dtUp);
    VK_DOWN:     MoveImage(dtDown);
    VK_LEFT:     MoveImage(dtLeft);
    VK_RIGHT:    MoveImage(dtRight);
    VK_SPACE:    begin
                   if CurrentRelativeIndex = Length(IndexArray) - 1 then
                     actFirst.Execute
                   else
                     actNext.Execute;
                 end;
    else
      inherited;
  end;
end;

procedure TfmImageViewer.actFitWidthExecute(Sender: TObject);
begin
  InitFitStatus;
  actFitWidth.Checked := True;
  AutoFitImage;
end;

procedure TfmImageViewer.actFitHeightExecute(Sender: TObject);
begin
  InitFitStatus;
  actFitHeight.Checked := True;
  AutoFitImage;
end;

procedure TfmImageViewer.actAutoFitExecute(Sender: TObject);
begin
  InitFitStatus;
  actAutoFit.Checked := True;
  AutoFitImage;
end;

procedure TfmImageViewer.actSaveAsExecute(Sender: TObject);
var
  OriginalFileExt: String;
  CurListItem: TListItem;
begin
  SaveDialog.Filter := 'CYC Files(*.CYC)|*.CYC';
  CurListItem := ImageList.Items.Item[GetAbsoluteIndex(CurrentRelativeIndex)];
  OriginalFileExt := UpperCase(PListItemObj(CurListItem.Data)^.OriginalExtName);
  if OriginalFileExt <> '.CYC' then
  begin
    SaveDialog.Filter := SaveDialog.Filter + '|' + Copy(OriginalFileExt, 2, Length(OriginalFileExt)) + ' Files(*' + OriginalFileExt + ')|*' + OriginalFileExt;
  end;
  SaveDialog.DefaultExt := '.CYC';
  if SaveDialog.Execute then
  begin
    if GetFileExtension(SaveDialog.FileName) = '.CYC' then
    begin
      CopyFile(PChar(pRootPath + PListItemObj(CurListItem.Data)^.FileName), PChar(SaveDialog.FileName), False);
    end
    else
      DecryptFile(pRootPath + PListItemObj(CurListItem.Data)^.FileName, SaveDialog.FileName, PubFuns.PasswordKey);
  end;
end;

procedure TfmImageViewer.actPrintExecute(Sender: TObject);
begin
  fmPrint := TfmPrint.Create(Self);
  try
    fmPrint.ShowModal;
  finally
    FreeAndNil(fmPrint);
  end;
end;

procedure TfmImageViewer.actZoomOutExecute(Sender: TObject);
begin
  InitFitStatus;
  if IsAutoFit then
  begin
    imgPreview.Width := Round(imgPreview.Width / 1.5);
    imgPreview.Height := Round(imgPreview.Height / 1.5);
    AlignCenter(pnlPreview, imgPreview);
    cbxZoomTo.Text := IntToStr(Round(imgPreview.Height / imgPreview.Bitmap.Height * 100));
    StatusBar.Panels[1].Text := IntToStr(Round(imgPreview.Height / imgPreview.Bitmap.Height * 100)) + '%';
  end;
end;

procedure TfmImageViewer.actZoomInExecute(Sender: TObject);
begin
  InitFitStatus;
  if IsAutoFit then
  begin
    imgPreview.Width := Round(imgPreview.Width * 1.5);
    imgPreview.Height := Round(imgPreview.Height * 1.5);
    AlignCenter(pnlPreview, imgPreview);
    cbxZoomTo.Text := IntToStr(Round(imgPreview.Height / imgPreview.Bitmap.Height * 100));
    StatusBar.Panels[1].Text := IntToStr(Round(imgPreview.Height / imgPreview.Bitmap.Height * 100)) + '%';
  end;
end;

procedure TfmImageViewer.actFirstExecute(Sender: TObject);
begin
  CurrentRelativeIndex := 0;
  RefreshNavigateButton;
  LoadFile(ImageList.Items.Item[GetAbsoluteIndex(CurrentRelativeIndex)]);
  RefreshStatusBar(ImageList.Items[GetAbsoluteIndex(CurrentRelativeIndex)]);
end;

procedure TfmImageViewer.actPreviousExecute(Sender: TObject);
begin
  if CurrentRelativeIndex > 0 then
  begin
    Dec(CurrentRelativeIndex);
    RefreshNavigateButton;
    LoadFile(ImageList.Items.Item[GetAbsoluteIndex(CurrentRelativeIndex)]);
    RefreshStatusBar(ImageList.Items[GetAbsoluteIndex(CurrentRelativeIndex)]);
  end;
end;

procedure TfmImageViewer.actNextExecute(Sender: TObject);
begin
  if CurrentRelativeIndex < Length(IndexArray) then
  begin
    Inc(CurrentRelativeIndex);
    RefreshNavigateButton;
    LoadFile(ImageList.Items.Item[GetAbsoluteIndex(CurrentRelativeIndex)]);
    RefreshStatusBar(ImageList.Items[GetAbsoluteIndex(CurrentRelativeIndex)]);
  end;
end;

procedure TfmImageViewer.actLastExecute(Sender: TObject);
begin
  CurrentRelativeIndex := Length(IndexArray) - 1;
  RefreshNavigateButton;
  LoadFile(ImageList.Items.Item[GetAbsoluteIndex(CurrentRelativeIndex)]);
  RefreshStatusBar(ImageList.Items[GetAbsoluteIndex(CurrentRelativeIndex)]);
end;

procedure TfmImageViewer.actRotateLeftExecute(Sender: TObject);
var
  TempLength: Integer;
begin
  if IsAutoFit then
  begin
    imgPreview.Bitmap.Rotate270();
    TempLength := imgPreview.Width;
    imgPreview.Width := imgPreview.Height;
    imgPreview.Height := TempLength;
    AlignCenter(pnlPreview, imgPreview);
  end;
end;

procedure TfmImageViewer.actRotateRightExecute(Sender: TObject);
var
  TempLength: Integer;
begin
  if IsAutoFit then
  begin
    imgPreview.Bitmap.Rotate90();
    TempLength := imgPreview.Width;
    imgPreview.Width := imgPreview.Height;
    imgPreview.Height := TempLength;
    AlignCenter(pnlPreview, imgPreview);
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: InitFitStatus
  Purpose:   Initialize Fit Status
  Arguments: None
  Result:    None
  Author:    Cyclone
  History:   2004-7-21 23:34:49

-----------------------------------------------------------------------------}
procedure TfmImageViewer.InitFitStatus;
begin
  actFitWidth.Checked := False;
  actFitHeight.Checked := False;
  actAutoFit.Checked := False;
end;

{-----------------------------------------------------------------------------
  Procedure: AutoFitImage
  Purpose:   Auto Fit Image
  Arguments: None
  Result:    None
  Author:    Cyclone
  History:   2004-7-21 23:55:26

-----------------------------------------------------------------------------}
procedure TfmImageViewer.AutoFitImage;
begin
  if IsAutoFit then
  begin
    if actFitWidth.Checked then
      FitImage(pnlPreview, imgPreview, ftFitWidth)
    else if actFitHeight.Checked then
      FitImage(pnlPreview, imgPreview, ftFitHeight)
    else if actAutoFit.Checked then
      FitImage(pnlPreview, imgPreview, ftAutoFit);

⌨️ 快捷键说明

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