📄 atviewer.pas
字号:
end;
finally
Bmp.Free;
end;
end;
{$endif}
//
procedure LoadImageWithDelphi;
begin
FImageBox.Image.Picture.LoadFromFile(FFileName);
FImageBox.UpdateImageInfo;
end;
//
{$ifdef IJL}
function LoadImageWithIJL: Boolean;
var
bmp: TBitmap;
begin
Result := False;
FIsImageIJL := True;
//Load IJL dinamycally here
if (ijlLib = 0) then
if not LoadIJL then Exit;
bmp := TBitmap.Create;
try
if LoadBmpFromJpegFile(bmp, FFileNameWideToAnsi(FFileName), True) then
begin
FImageBox.Image.Transparent := False;
FImageBox.Image.Picture.Assign(bmp);
FImageBox.UpdateImageInfo;
Result := True;
end;
finally
bmp.Free;
end;
end;
{$endif}
//
procedure LoadImageFromPicture(APicture: TPicture);
begin
FImageBox.Image.Picture.Assign(APicture);
FImageBox.UpdateImageInfo;
end;
//
procedure UnloadImage;
begin
FImageBox.Image.Picture := nil;
FImageBox.UpdateImageInfo;
end;
//
procedure ShowImageError(const Msg: AnsiString);
begin
UnloadImage;
FImageError := True;
FImageErrorMessage := Msg;
if FImageErrorMessageBox then
MsgError(Msg);
end;
//
{$ifdef IVIEW}
var
IViewHighPriority: Boolean;
{$endif}
begin
FImageError := False;
FImageErrorMessage := '';
FImageBPP := 0;
FIsImageIView := False;
FIsImageIJL := False;
//If an image was loaded before, then we need to switch between
//"internal library" and "IrfanView" modes. We do this by setting the
//IViewHighPriority local variable to False/True, otherwise it's set
//according to IViewIntegration.HighPriority property.
{$ifdef IVIEW}
if FIsImageBefore then
IViewHighPriority := not FIsImageIView
else
IViewHighPriority := FIViewIntegration.HighPriority;
{$endif}
if Assigned(FImageBox) then
try
try
DoCursorHours;
//Load from TPicture object
if Assigned(APicture) then
begin
LoadImageFromPicture(APicture);
Exit;
end;
{$ifdef IVIEW}
//1) Load with IView with high priority
if IViewIntegration.Enabled and IViewHighPriority then
if SFileExtensionMatch(FFileName, IViewIntegration.ExtList) then
begin
LoadImageWithIView;
Exit;
end;
{$endif}
{$ifdef ANI}
//1a) Load ANI
if SFileExtensionMatch(FFileName, 'ani') then
begin
if not LoadAni then
raise EInvalidGraphic.Create(Format(MsgViewerErrCannotLoadFile, ['AmnAni.dll']));
Exit;
end;
{$endif}
//1b) Load CUR
if SFileExtensionMatch(FFileName, 'cur') then
begin
if not LoadCur then
raise Exception.Create('');
Exit;
end;
{$ifdef IJL}
//2) Load with IJL
if FIJLIntegration.Enabled then
if SFileExtensionMatch(FFileName, FIJLIntegration.ExtList) then
begin
if LoadImageWithIJL then Exit;
end;
{$endif}
//3) Load with Delphi
if SFileExtensionMatch(FFileName, ATViewerOptions.ExtImages) then
begin
try
LoadImageWithDelphi;
except
{$ifdef IVIEW}
//If library couldn't load an image, switch to IView implicitly
//(so useless error messagebox won't appear)
if IViewIntegration.Enabled then
if SFileExtensionMatch(FFileName, IViewIntegration.ExtList) then
begin
LoadImageWithIView;
Exit;
end;
{$endif}
//If IView couldn't help here, show error messagebox finally
raise;
end;
Exit;
end;
{$ifdef IVIEW}
//4) Load with IView with low priority
if IViewIntegration.Enabled and (not IViewHighPriority) then
if SFileExtensionMatch(FFileName, IViewIntegration.ExtList) then
begin
LoadImageWithIView;
Exit;
end;
{$endif}
UnloadImage;
finally
DoCursorDefault;
FImageBPP := GetImageBPP; //Updated only on image reading
end;
except
on E: EInvalidGraphic do
ShowImageError(E.Message)
else
ShowImageError(MsgViewerErrImage);
end;
end;
procedure TATViewer.LoadMedia(APicture: TPicture = nil);
//
procedure ShowMediaError(const Msg: AnsiString);
begin
if Msg <> '' then
MsgError(Msg)
else
MsgError(MsgViewerErrMedia);
end;
//
begin
Assert(FFileName <> '', 'FileName not assigned');
if SFileExtensionMatch(FFileName, ActualExtImages) then
try
FreeData(False);
FIsImage := True;
InitImage;
if Assigned(FImageBox) then
begin
FImageBox.Color := FImageColor;
FImageBox.ImageDrag := FImageDrag;
FImageBox.Image.Cursor := FImageCursor;
FImageBox.ImageDragCursor := FImageDragCursor;
FImageBox.Image.Transparent := FImageTransparent;
FImageBox.Image.Resample := FImageResample;
FImageBox.Image.ResampleBackColor := FImageColor;
LoadImage(APicture);
{$ifdef GIF}
if Assigned(FImageBox.Image.Picture.Graphic) and
(FImageBox.Image.Picture.Graphic is TGifImage) then
with (FImageBox.Image.Picture.Graphic as TGifImage) do
begin
if FImageTransparent or
((Images.Count > 1) and IsTransparent) //Always set transparency for (animaged + transparent) images
then
DrawOptions := DrawOptions + [goTransparent]
else
DrawOptions := DrawOptions - [goTransparent];
end;
{$endif}
FImageBox.ImageFitToWindow := FMediaFit;
FImageBox.ImageFitOnlyBig := FMediaFitOnlyBig;
FImageBox.ImageCenter := FMediaCenter;
FImageBox.ImageKeepPosition := FImageKeepPosition;
FImageBox.BorderStyle := FBorderStyleInner;
FImageBox.Show;
if CanSetFocus then
FImageBox.SetFocus;
FIsIcon := SFileExtensionMatch(FFileName, 'ico'); //FImageBox.Image.Picture.Graphic is TIcon;
FIsMetafile := FImageBox.Image.Picture.Graphic is TMetafile;
end;
except
end
else
begin
FreeData;
FIsMedia := True;
MediaSyncVolume;
InitMedia;
{$ifdef MEDIA_PLAYER}
if (FMediaMode = vmmodeMCI) and Assigned(FMedia) then
try
try
DoCursorHours;
FMediaPanel.Show;
SetMediaPosition;
FMedia.FileName := FFileName;
FMedia.Notify := True;
FMedia.Open;
FMedia.Enabled := True;
FMediaBar.Enabled := True;
FMediaBar.Max := FMedia.Length;
if CanSetFocus then
FMedia.SetFocus;
if FMediaAutoPlay then
FMedia.Play;
finally
DoCursorDefault;
end;
except
on E: EMCIDeviceError do
ShowMediaError(E.Message)
else
ShowMediaError('');
end;
{$endif}
{$ifdef MEDIA_WMP64}
if (FMediaMode = vmmodeWMP64) and Assigned(FWMP6) then
try
with FWMP6 do
begin
VideoBorder3D := FBorderStyleInner <> bsNone;
ShowStatusBar := True;
ShowControls := FWMP6Controls;
ShowTracker := FWMP6Tracker;
Show;
if CanSetFocus then
SetFocus;
Volume:= Vol_AtoW6(FMediaVolume);
Mute:= FMediaMute;
if FMediaLoop then
PlayCount := MaxInt
else
PlayCount := FMediaPlayCount;
AutoStart := FMediaAutoPlay;
SetMediaFit_WMP6(FWMP6);
SetMediaPosition;
FileName := FFileName;
end;
except
on E: Exception do
ShowMediaError(E.Message);
end;
{$endif}
{$ifdef MEDIA_WMP9}
if (FMediaMode = vmmodeWMP9) and Assigned(FWMP9) then
try
with FWMP9 do
begin
Show;
if CanSetFocus then
SetFocus;
Settings.Volume:= Vol_AtoW9(FMediaVolume);
Settings.Mute:= FMediaMute;
if FMediaLoop then
Settings.PlayCount := MaxInt
else
Settings.PlayCount := FMediaPlayCount;
Settings.AutoStart := FMediaAutoPlay;
SetMediaFit_WMP9(FWMP9);
SetMediaPosition;
URL := FFileName;
end;
except
on E: Exception do
ShowMediaError(E.Message);
end;
{$endif}
end;
end;
procedure TATViewer.LoadBinary;
var
ANewFile: Boolean;
begin
Assert(FFileName <> '', 'FileName not assigned');
//Is file new for ATBinHex component?
ANewFile := FFileName <> FBinHex.FileName;
//Clear data only when file is new,
//and clear search anyway:
if ANewFile then
FreeData;
FreeSearch;
with FBinHex do
begin
Color := FTextColor;
BorderStyle := FBorderStyleInner;
TextEncoding := FTextEncoding;
TextWrap := FTextWrap;
case Self.FMode of
vmodeText:
Mode := vbmodeText;
vmodeBinary:
Mode := vbmodeBinary;
vmodeHex:
Mode := vbmodeHex;
vmodeUnicode:
//If Unicode mode already activated, switch to UHex mode:
if (not ANewFile) and (Mode = vbmodeUnicode) then
Mode := vbmodeUHex
else
Mode := vbmodeUnicode;
end;
if ANewFile then
Open(FFileName);
Show;
if CanSetFocus then
SetFocus;
end;
end;
procedure TATViewer.LoadRTF;
begin
Assert(FFileName <> '', 'FileName not assigned');
FreeData;
InitEdit;
if Assigned(FEdit) then
with FEdit do
begin
//work around RichEdit bug, reset font
Font.Name := 'Webdings';
Font.Size := 8;
Font.Color := clWhite;
Font := GetTextFont;
//RichEdit bug: WordWrap assignment must be after Font assignment, or font will be broken
Color := FTextColor;
WordWrap := FTextWrap;
BorderStyle := FBorderStyleInner;
try
try
DoCursorHours;
RE_LoadFile(FEdit, FFileName, 0, 0);
TextSelectionChange(Self);
finally
DoCursorDefault;
end;
except
MsgError(SFormatW(MsgViewerErrCannotLoadFile, [FFileName]));
end;
Show;
if CanSetFocus then
SetFocus;
end;
end;
procedure TATViewer.LoadWeb;
begin
Assert(FFileName <> '', 'FileName not assigned');
FreeData;
InitWeb;
if Assigned(FBrowser) then
try
if WebBrowserSafe then
if FBorderStyleInner = bsNone then
WB_Set3DBorderStyle(FBrow
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -