📄 imageviewerf.pas
字号:
cbxZoomTo.Text := IntToStr(Round(imgPreview.Height / imgPreview.Bitmap.Height * 100));
StatusBar.Panels[1].Text := IntToStr(Round(imgPreview.Height / imgPreview.Bitmap.Height * 100)) + '%';
end
else
AlignCenter(pnlPreview, imgPreview);
end;
procedure TfmImageViewer.FormResize(Sender: TObject);
begin
inherited;
if Self.Visible then
begin
InitFitStatus;
actAutoFit.Checked := True;
AutoFitImage;
end;
end;
{-----------------------------------------------------------------------------
Procedure: RefreshNavigateButton
Purpose: Refresh Navigate Button
Arguments: None
Result: None
Author: Cyclone
History: 2004-7-23 0:11:55
-----------------------------------------------------------------------------}
procedure TfmImageViewer.RefreshNavigateButton;
begin
actFirst.Enabled := CurrentRelativeIndex > 0;
actPrevious.Enabled := CurrentRelativeIndex > 0;
actNext.Enabled := CurrentRelativeIndex < Length(IndexArray) - 1;
actLast.Enabled := CurrentRelativeIndex < Length(IndexArray) - 1;
end;
{-----------------------------------------------------------------------------
Procedure: InitIndexArray
Purpose: Initialize Index Array
Arguments: None
Result: None
Author: Cyclone
History: 2004-7-22 23:36:37
-----------------------------------------------------------------------------}
procedure TfmImageViewer.InitIndexArray;
var
i,
ArrayLength: Integer;
begin
ArrayLength := 0;
with ImageList.Items do
begin
for i := 0 to Count - 1 do
begin
if PListItemObj(Item[i].Data)^.ItemType = itDocument then
begin
Inc(ArrayLength);
SetLength(IndexArray, ArrayLength);
IndexArray[ArrayLength - 1] := i;
end;
end;
end;
if ArrayLength = 0 then
begin
SetLength(IndexArray, 1);
IndexArray[0] := CurrentAbsoluteIndex;
end;
end;
{-----------------------------------------------------------------------------
Procedure: GetAbsoluteIndex
Purpose: Get Absolute Index
Arguments: const RelativeIndex
Result: Integer
Author: Cyclone
History: 2004-7-22 23:46:28
-----------------------------------------------------------------------------}
function TfmImageViewer.GetAbsoluteIndex(const RelativeIndex: Integer): Integer;
begin
Result := -1;
if (RelativeIndex >=0) and (RelativeIndex < Length(IndexArray)) then
Result := IndexArray[RelativeIndex];
end;
{-----------------------------------------------------------------------------
Procedure: GetRelativeIndex
Purpose: Get Relative Index
Arguments: const AbsoluteIndex
Result: Integer
Author: Cyclone
History: 2004-7-22 23:46:33
-----------------------------------------------------------------------------}
function TfmImageViewer.GetRelativeIndex(const AbsoluteIndex: Integer): Integer;
var
i: Integer;
begin
Result := -1;
for i := 0 to Length(IndexArray) - 1 do
begin
if IndexArray[i] = AbsoluteIndex then
begin
Result := i;
Break;
end;
end;
end;
procedure TfmImageViewer.TimerTimer(Sender: TObject);
var
CurrentPos: TPoint;
XGap, YGap: Integer;
iPos: Integer;
begin
if not IsMoving then
Exit;
GetCursorPos(CurrentPos);
XGap := CurrentPos.X - OriginalPos.X;
YGap := CurrentPos.Y - OriginalPos.Y;
if (XGap <> 0) or (YGap <> 0) then
begin
if imgPreview.Width > pnlPreview.Width then
begin
if XGap > 0 then
begin
iPos := imgPreview.Left + XGap;
if iPos > 0 then
iPos := 0;
imgPreview.Left := iPos;
end
else
begin
iPos := imgPreview.Left + XGap;
if iPos < pnlPreview.Width - imgPreview.Width then
iPos := pnlPreview.Width - imgPreview.Width;
imgPreview.Left := iPos;
end;
end;
if imgPreview.Height > pnlPreview.Height then
begin
if YGap > 0 then
begin
iPos := imgPreview.Top + YGap;
if iPos > 0 then
iPos := 0;
imgPreview.Top := iPos;
end
else
begin
iPos := imgPreview.Top + YGap;
if iPos < pnlPreview.Height - imgPreview.Height then
iPos := pnlPreview.Height - imgPreview.Height;
imgPreview.Top := iPos;
end;
end;
OriginalPos := CurrentPos;
end;
end;
{-----------------------------------------------------------------------------
Procedure: ShellOpenFile
Purpose: Shell Open File
Arguments: AItem: TListItem
Result: None
Author: Cyclone
History: 2004-11-28 23:33:31
-----------------------------------------------------------------------------}
procedure TfmImageViewer.ShellOpenFile(AItem: TListItem);
var
FullFileName,
TempFileName: String;
begin
FullFileName := pRootPath + PListItemObj(AItem.Data)^.FileName;
if not FileExists(FullFileName) then
begin
ShowError('Cannot find file: ' + FullFileName + PubFuns.CRLF +
'Please check system options are set correctly.');
Exit;
end;
TempFileName := GetSystemTempFileName(GetSystemTempPath, 'Cyc', 10);
TempFileName := ChangeFileExt(TempFileName, PListItemObj(AItem.Data)^.OriginalExtName);
DecryptFile(FullFileName, TempFileName, PubFuns.PasswordKey);
SetFileAttributes(PChar(TempFileName), FILE_ATTRIBUTE_HIDDEN);
ShellExecute(Handle, 'OPEN', PChar(TempFileName), '', '', SW_SHOWMAXIMIZED);
HistoryFileNameList.Add(TempFileName);
end;
procedure TfmImageViewer.FormCreate(Sender: TObject);
begin
inherited;
HistoryFileNameList := TStringList.Create;
Self.Left := pImagePreviewLeft;
Self.Top := pImagePreviewTop;
Self.Height := pImagePreviewHeight;
Self.Width := pImagePreviewWidth;
Self.WindowState := pImagePreviewState;
actViewInformation.Checked := pImagePreviewShowInformation;
SetShowInformation(actViewInformation.Checked);
end;
procedure TfmImageViewer.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
inherited;
CurrentAbsoluteIndex := GetAbsoluteIndex(CurrentRelativeIndex);
pImagePreviewLeft := Self.Left;
pImagePreviewTop :=Self.Top;
pImagePreviewHeight := Self.Height;
pImagePreviewWidth := Self.Width;
pImagePreviewState := Self.WindowState;
pImagePreviewShowInformation := actViewInformation.Checked;
DeleteHistoryFiles(HistoryFileNameList);
end;
procedure TfmImageViewer.FormDestroy(Sender: TObject);
begin
inherited;
FreeAndNil(HistoryFileNameList);
end;
{-----------------------------------------------------------------------------
Procedure: MoveImage
Purpose: Move Image
Arguments: const Direction: TDirection
Result: None
Author: Cyclone
History: 2004-11-30 0:15:16
-----------------------------------------------------------------------------}
procedure TfmImageViewer.MoveImage(const Direction: TDirection);
var
iPos: Integer;
begin
case Direction of
dtUp: begin
if imgPreview.Height > pnlPreview.Height then
begin
iPos := imgPreview.Top + YInterval;
if iPos > 0 then
iPos := 0;
imgPreview.Top := iPos;
end;
end;
dtDown: begin
if imgPreview.Height > pnlPreview.Height then
begin
iPos := imgPreview.Top - YInterval;
if iPos < pnlPreview.Height - imgPreview.Height then
iPos := pnlPreview.Height - imgPreview.Height;
imgPreview.Top := iPos;
end;
end;
dtLeft: begin
if imgPreview.Width > pnlPreview.Width then
begin
iPos := imgPreview.Left + XInterval;
if iPos > 0 then
iPos := 0;
imgPreview.Left := iPos;
end;
end;
dtRight: begin
if imgPreview.Width > pnlPreview.Width then
begin
iPos := imgPreview.Left - YInterval;
if iPos < pnlPreview.Width - imgPreview.Width then
iPos := pnlPreview.Width - imgPreview.Width;
imgPreview.Left := iPos;
end;
end;
end;
end;
procedure TfmImageViewer.actAboutExecute(Sender: TObject);
begin
fmAbout := TfmAbout.Create(Application);
try
fmAbout.ShowModal;
finally
fmAbout.Free;
end;
end;
procedure TfmImageViewer.pnlInformationResize(Sender: TObject);
begin
inherited;
edtDocNo.Width := pnlInformation.Width - 16;
edtDocType.Width := edtDocNo.Width;
edtDocName.Width := edtDocNo.Width;
edtFileName.Width := edtDocNo.Width;
edtVersion.Width := edtDocNo.Width;
edtRemarks.Width := edtDocNo.Width;
end;
{-----------------------------------------------------------------------------
Procedure: TfmImageViewer.RefreshInformation
Purpose: Refresh Information
Arguments: AItem: TListItem;
Result: None
Author: Cyclone
History: 2004-12-1 23:29:52
-----------------------------------------------------------------------------}
procedure TfmImageViewer.RefreshInformation(AItem: TListItem);
begin
with PListItemObj(AItem.Data)^ do
begin
edtDocNo.Text := DocNo;
edtDocType.Text := DocType;
edtDocName.Text := DocName;
edtFileName.Text := FileName;
edtVersion.Text := Version;
edtRemarks.Text := Remarks;
end;
end;
procedure TfmImageViewer.OnSysCommand(var Msg: TWMSysCommand);
begin
if (Msg.CmdType = SC_MINIMIZE) then
Hide
else
inherited;
end;
{-----------------------------------------------------------------------------
Procedure: TfmImageViewer.RefreshStatusBar
Purpose: Refresh Status Bar
Arguments: AItem: TListItem
Result: None
Author: Cyclone
History: 2004-12-20 22:24:33
-----------------------------------------------------------------------------}
procedure TfmImageViewer.RefreshStatusBar(AItem: TListItem);
var
FileType: String;
ItemsSize: Double;
begin
// if not Assigned(imgPreview.Bitmap.Graphic) then
// Exit;
StatusBar.Panels[0].Text := IntToStr(CurrentRelativeIndex + 1) + '/' + IntToStr(Length(IndexArray));
StatusBar.Panels[1].Text := IntToStr(Round(imgPreview.Height / imgPreview.Bitmap.Height * 100)) + '%';
StatusBar.Panels[2].Text := IntToStr(imgPreview.Bitmap.Width) + ' X ' + IntToStr(imgPreview.Bitmap.Height);
StatusBar.Panels[3].Text := DateTimeToStr(PListItemObj(AItem.Data)^.CreateDate) + '*';
FileType := PListItemObj(AItem.Data)^.OriginalExtName;
StatusBar.Panels[4].Text := 'Type: ' + Copy(FileType, 2, Length(FileType)) + ' Files';
ItemsSize := GetFileSize(pRootPath + PListItemObj(AItem.Data)^.FileName);
if ItemsSize > 0 then
StatusBar.Panels[4].Text := StatusBar.Panels[4].Text + ' Size: ' + Format('%.0n', [ItemsSize]);
end;
{-----------------------------------------------------------------------------
Procedure: TfmImageViewer.SetShowInformation
Purpose: Set Show Information
Arguments: const ShowInformation: Boolean
Result: None
Author: Cyclone
History: 2004-12-25 12:57:30
-----------------------------------------------------------------------------}
procedure TfmImageViewer.SetShowInformation(
const ShowInformation: Boolean);
begin
if ShowInformation then
begin
SptWidth.Visible := True;
pnlInformation.Visible := True;
actViewInformation.ImageIndex := 15;
actViewInformation.Hint := 'Hide Information';
end
else
begin
SptWidth.Visible := False;
pnlInformation.Visible := False;
actViewInformation.ImageIndex := 14;
actViewInformation.Hint := 'Show Information';
end;
end;
procedure TfmImageViewer.cbxZoomToClick(Sender: TObject);
begin
actZoomTo.Execute;
end;
procedure TfmImageViewer.actZoomToExecute(Sender: TObject);
begin
if IsAutoFit and (StrToIntDef(cbxZoomTo.Text, 0) > 0) then
begin
InitFitStatus;
imgPreview.Height := Round(imgPreview.Bitmap.Height * StrToInt(cbxZoomTo.Text) / 100);
imgPreview.Width := Round(imgPreview.Bitmap.Width * StrToInt(cbxZoomTo.Text) / 100);
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.cbxZoomToKeyPress(Sender: TObject; var Key: Char);
var
KeyValue: Integer;
begin
KeyValue := Ord(Key);
if not (((KeyValue >= 48) and (KeyValue <= 57)) or
(KeyValue = VK_BACK) or (KeyValue = VK_RETURN) or (KeyValue = VK_DELETE)) then
begin
Key := #0;
end;
end;
procedure TfmImageViewer.actAutoAdvanceExecute(Sender: TObject);
begin
actAutoAdvance.Checked := not actAutoAdvance.Checked;
TimAutoAdvance.Enabled := actAutoAdvance.Checked;
end;
procedure TfmImageViewer.TimAutoAdvanceTimer(Sender: TObject);
begin
if actNext.Enabled then
actNext.Execute
else
actFirst.Execute;
end;
procedure TfmImageViewer.imgPreviewDblClick(Sender: TObject);
begin
if not IsImage(ImageList.Items.Item[GetAbsoluteIndex(CurrentRelativeIndex)]) then
ShellOpenFile(ImageList.Items.Item[GetAbsoluteIndex(CurrentRelativeIndex)]);
end;
procedure TfmImageViewer.imgPreviewMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer;
Layer: TCustomLayer);
begin
// ReleaseCapture;
// imgPreview.Perform(WM_SYSCOMMAND, $F012, 0);
IsMoving := (imgPreview.Width >= pnlPreview.Width) or (imgPreview.Height >= pnlPreview.Height);
Timer.Enabled := IsMoving;
GetCursorPos(OriginalPos);
end;
procedure TfmImageViewer.imgPreviewMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
if (imgPreview.Width >= pnlPreview.Width) or (imgPreview.Height >= pnlPreview.Height) then
Screen.Cursor := crHandPoint
else
Screen.Cursor := crDefault;
end;
procedure TfmImageViewer.imgPreviewMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer;
Layer: TCustomLayer);
begin
IsMoving := False;
Timer.Enabled := False;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -