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

📄 imageviewerf.pas

📁 极具实用价值的文件管理系统
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    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 + -