📄 imageviewerf.pas
字号:
{ *********************************************************************** }
{ 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 + -