官方bilibiliWindows破解入门Android逆向入门
【网络诊断修复工具】切换到窄版

吾爱破解 - 52pojie.cn

 找回密码
 注册[Register]

QQ登录

只需一步，快速开始

吾爱破解 - 52pojie.cn»网站 › 【 软件安全 】 › 『编程语言区』 › 『编程语言讨论求助区』 › 使用Delphi自己写款PicaView右键菜单看图软件
12下一页
返回列表 发新帖
查看: 313|回复: 12
收起左侧

[学习记录] 使用Delphi自己写款PicaView右键菜单看图软件

[复制链接]
冥界3大法王
冥界3大法王 发表于 2026-5-8 16:51
本帖最后由 冥界3大法王 于 2026-5-8 17:19 编辑

无费话，直接上代码：
uShellExt.pas
[Delphi] 纯文本查看 复制代码
unit uShellExt;

interface

uses
  Winapi.Windows, Winapi.ActiveX, Winapi.ShlObj, Winapi.ShellAPI, System.Classes,
  System.SysUtils, System.Win.ComObj, ComServ, Vcl.Forms;

type
  TPicaViewExt = class(TComObject, IShellExtInit, IContextMenu)
  private
    FFiles: TStringList;
    FThumbForm: TForm;
  protected
    function IShellExtInit.Initialize = InitShellExt;
    function InitShellExt(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult; stdcall;
    function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
    function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
    function GetCommandString(idCmd: UINT_PTR; uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult; stdcall;
  public
    procedure Initialize; override;
    destructor Destroy; override;
  end;

  TPicaViewFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

const
  CLSID_PicaView: TGUID = '{C1B2D3E4-F5A6-7890-ABCD-EF123456789A}';

implementation

uses
  System.Win.Registry, Vcl.Dialogs, uThumbnailForm, ImageViewerForm;

const
  SHELLEX_KEY = '*\shellex\ContextMenuHandlers\PicaView';
  IMAGE_EXTS: array[0..8] of string = ('.bmp', '.jpg', '.jpeg', '.png', '.gif', '.tiff', '.tif', '.ico', '.wmf');
  MENU_VERB = '用PicaView查看';

function IsImageFile(const AFileName: string): Boolean;
var
  S, E: string;
begin
  E := LowerCase(ExtractFileExt(AFileName));
  for S in IMAGE_EXTS do
    if S = E then
      Exit(True);
  Result := False;
end;

{ TPicaViewExt }

procedure TPicaViewExt.Initialize;
begin
  inherited;
  FFiles := TStringList.Create;
  FThumbForm := nil;
end;

destructor TPicaViewExt.Destroy;
begin
  FThumbForm := nil;
  FFiles.Free;
  inherited;
end;

function TPicaViewExt.InitShellExt(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
var
  FmtEtc: TFormatEtc;
  Medium: TStgMedium;
  I, FileCount: Integer;
  Buffer: array[0..MAX_PATH] of Char;
begin
  Result := E_FAIL;
  if lpdobj = nil then
    Exit;

  FmtEtc.cfFormat := CF_HDROP;
  FmtEtc.ptd := nil;
  FmtEtc.dwAspect := DVASPECT_CONTENT;
  FmtEtc.lindex := -1;
  FmtEtc.tymed := TYMED_HGLOBAL;

  if lpdobj.GetData(FmtEtc, Medium) <> S_OK then
    Exit;
  try
    FileCount := DragQueryFile(Medium.hGlobal, $FFFFFFFF, nil, 0);
    for I := 0 to FileCount - 1 do
    begin
      DragQueryFile(Medium.hGlobal, I, Buffer, MAX_PATH);
      if IsImageFile(Buffer) then
        FFiles.Add(Buffer);
    end;
    if FFiles.Count > 0 then
      Result := S_OK
    else
      Result := S_FALSE;
  finally
    ReleaseStgMedium(Medium);
  end;
end;

function TPicaViewExt.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;
var
  Pt: TPoint;
begin
  if FFiles.Count = 0 then
  begin
    Result := 0;
    Exit;
  end;
  if (uFlags and (CMF_DEFAULTONLY or CMF_NOVERBS)) <> 0 then
  begin
    Result := 0;
    Exit;
  end;
  if not InsertMenuW(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst, PWideChar(MENU_VERB)) then
  begin
    Result := E_FAIL;
    Exit;
  end;

  if FFiles.Count > 0 then
  begin
    GetCursorPos(Pt);
    FThumbForm := TfrmThumbnail.Create(nil);
    TfrmThumbnail(FThumbForm).ShowAt(FFiles[0], Pt);
  end;

  Result := 1;
end;

function TPicaViewExt.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
  FileList: TStringList;
  FilePath, CurrentPath, Ext: string;
  SearchRec: TSearchRec;
  StartIndex: Integer;
begin
  if Assigned(FThumbForm) then
  begin
    FThumbForm.Release;
    FThumbForm := nil;
  end;

  if FFiles.Count = 0 then
  begin
    Result := S_OK;
    Exit;
  end;

  FilePath := FFiles[0];
  Ext := LowerCase(ExtractFileExt(FilePath));
  if (Ext <> '.jpg') and (Ext <> '.jpeg') and (Ext <> '.png') and (Ext <> '.bmp') and (Ext <> '.gif') and (Ext <> '.tiff') then
  begin
    Result := S_OK;
    Exit;
  end;

  FileList := TStringList.Create;
  try
    CurrentPath := IncludeTrailingPathDelimiter(ExtractFilePath(FilePath));
    StartIndex := -1;
    if FindFirst(CurrentPath + '*.*', faAnyFile, SearchRec) = 0 then
    begin
      repeat
        if (SearchRec.Attr and faDirectory) <> 0 then
          Continue;
        Ext := LowerCase(ExtractFileExt(SearchRec.Name));
        if (Ext = '.jpg') or (Ext = '.jpeg') or (Ext = '.png') or (Ext = '.bmp') or (Ext = '.gif') or (Ext = '.tiff') then
        begin
          if SameText(CurrentPath + SearchRec.Name, FilePath) then
            StartIndex := FileList.Count;
          FileList.Add(CurrentPath + SearchRec.Name);
        end;
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);
    end;
    if (FileList.Count > 0) and (StartIndex >= 0) then
    begin
      with TfrmImageViewer.Create(nil) do
        ShowImage(FileList, StartIndex);
    end;
  finally
    FileList.Free;
  end;

  Result := S_OK;
end;

function TPicaViewExt.GetCommandString(idCmd: UINT_PTR; uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;
begin
  if (idCmd = 0) and (uType = GCS_HELPTEXT) then
  begin
    lstrcpynA(pszName, '用PicaView快速查看图像文件', cchMax);
    Result := S_OK;
  end
  else
    Result := E_NOTIMPL;
end;

{ TPicaViewFactory }

procedure TPicaViewFactory.UpdateRegistry(Register: Boolean);
var
  Reg: TRegistry;
  ClsIdStr: string;
begin
  inherited;
  ClsIdStr := GUIDToString(CLSID_PicaView);
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CLASSES_ROOT;
    if Register then
    begin
      if Reg.OpenKey(SHELLEX_KEY, True) then
      begin
        Reg.WriteString('', ClsIdStr);
        Reg.CloseKey;
      end;
    end
    else
    begin
      if Reg.KeyExists(SHELLEX_KEY) then
        Reg.DeleteKey(SHELLEX_KEY);
    end;
  finally
    Reg.Free;
  end;
end;

initialization
  TPicaViewFactory.Create(ComServer, TPicaViewExt, CLSID_PicaView, 'PicaView', 'PicaView Shell Extension', ciMultiInstance, tmApartment);

end.


image.png

由于焦点问题，只能点击菜单项【用PicaView查看 】 这样就能全屏，前后浏览 ，ECS退出了！

ImageViewerForm.pas
[Delphi] 纯文本查看 复制代码
unit ImageViewerForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls, Vcl.StdCtrls, System.Math;

type
  TfrmImageViewer = class(TForm)
    imgMain: TImage;
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure imgMainMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure WMSysCmd(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
  private
    FFileList: TStringList;
    FCurrentIndex: Integer;
    FZoomFactor: Double;
    FOriginalPicture: TPicture;
    FFullscreen: Boolean;
    FSavedBorderStyle: TFormBorderStyle;
    FSavedWindowState: TWindowState;
    FSavedBounds: TRect;
    procedure LoadImage;
    procedure UpdateCaption;
    procedure MoveToPrevious;
    procedure MoveToNext;
    procedure ApplyZoom;
    procedure ToggleFullscreen;
    procedure ExitFullscreen;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ShowImage(const AFileList: TStringList; AStartIndex: Integer);
  end;

implementation
{$R *.dfm}

constructor TfrmImageViewer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFileList := TStringList.Create;
  FCurrentIndex := 0;
  FZoomFactor := 1.0;
  FOriginalPicture := TPicture.Create;
  FFullscreen := False;
end;

destructor TfrmImageViewer.Destroy;
begin
  FOriginalPicture.Free;
  FFileList.Free;
  inherited Destroy;
end;

procedure TfrmImageViewer.FormCreate(Sender: TObject);
begin
  KeyPreview := True;
  imgMain.Align := alClient;
  imgMain.OnMouseDown := imgMainMouseDown;
  PopupMode := pmExplicit;
  FormStyle := fsStayOnTop;
end;

procedure TfrmImageViewer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmImageViewer.WMSysCmd(var Msg: TWMSysCommand);
begin
  if Msg.CmdType = SC_CLOSE then
    Free
  else
    inherited;
end;

procedure TfrmImageViewer.ShowImage(const AFileList: TStringList; AStartIndex: Integer);
begin
  FFileList.Assign(AFileList);
  FCurrentIndex := AStartIndex;
  LoadImage;
  ShowWindow(Handle, SW_SHOW);
  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW);
  BringToFront;
  SetForegroundWindow(Handle);
end;

procedure TfrmImageViewer.UpdateCaption;
begin
  if (FCurrentIndex >= 0) and (FCurrentIndex < FFileList.Count) then
    Caption := Format('%s (%d/%d)', [ExtractFileName(FFileList[FCurrentIndex]), FCurrentIndex + 1, FFileList.Count])
  else
    Caption := '图片查看器';
end;

procedure TfrmImageViewer.LoadImage;
begin
  if (FCurrentIndex >= 0) and (FCurrentIndex < FFileList.Count) then
  begin
    try
      imgMain.Picture.LoadFromFile(FFileList[FCurrentIndex]);
      FOriginalPicture.Assign(imgMain.Picture);
      FZoomFactor := 1.0;
      UpdateCaption;
    except
      on E: Exception do
        ;
    end;
  end;
end;

procedure TfrmImageViewer.ApplyZoom;
var
  bmp: TBitmap;
  w, h: Integer;
begin
  if FOriginalPicture.Graphic = nil then Exit;

  FZoomFactor := EnsureRange(FZoomFactor, 0.05, 20.0);

  w := Max(1, Round(FOriginalPicture.Width * FZoomFactor));
  h := Max(1, Round(FOriginalPicture.Height * FZoomFactor));

  bmp := TBitmap.Create;
  try
    bmp.SetSize(w, h);
    bmp.Canvas.StretchDraw(Rect(0, 0, w, h), FOriginalPicture.Graphic);
    imgMain.Picture.Assign(bmp);
  finally
    bmp.Free;
  end;
end;

procedure TfrmImageViewer.ToggleFullscreen;
begin
  if FFullscreen then
    ExitFullscreen
  else
  begin
    FSavedBorderStyle := BorderStyle;
    FSavedWindowState := WindowState;
    FSavedBounds := BoundsRect;
    BorderStyle := bsNone;
    WindowState := wsMaximized;
    FFullscreen := True;
  end;
end;

procedure TfrmImageViewer.ExitFullscreen;
begin
  if not FFullscreen then Exit;
  BorderStyle := FSavedBorderStyle;
  WindowState := FSavedWindowState;
  BoundsRect := FSavedBounds;
  FFullscreen := False;
end;

procedure TfrmImageViewer.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_ESCAPE:
      begin
        if FFullscreen then
          ExitFullscreen
          else
            Free;
      end;

    VK_PRIOR, VK_LEFT:
      begin
        if FCurrentIndex > 0 then
        begin
          Dec(FCurrentIndex);
          LoadImage;
        end;
      end;

    VK_NEXT, VK_RIGHT, VK_SPACE:
      begin
        if FCurrentIndex < FFileList.Count - 1 then
        begin
          Inc(FCurrentIndex);
          LoadImage;
        end;
      end;
  end;
end;

procedure TfrmImageViewer.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    ToggleFullscreen;
end;

procedure TfrmImageViewer.imgMainMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    ToggleFullscreen;
end;

procedure TfrmImageViewer.MoveToPrevious;
begin
  if FCurrentIndex > 0 then
  begin
    Dec(FCurrentIndex);
    LoadImage;
  end;
end;

procedure TfrmImageViewer.MoveToNext;
begin
  if FCurrentIndex < FFileList.Count - 1 then
  begin
    Inc(FCurrentIndex);
    LoadImage;
  end;
end;

procedure TfrmImageViewer.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  if ssCtrl in Shift then
  begin
    if WheelDelta > 0 then
      FZoomFactor := FZoomFactor * 1.25
    else
      FZoomFactor := FZoomFactor * 0.8;
    ApplyZoom;
  end
  else
  begin
    if WheelDelta > 0 then
      MoveToPrevious
    else
      MoveToNext;
  end;
  Handled := True;
end;

procedure TfrmImageViewer.FormDblClick(Sender: TObject);
begin
  if FFullscreen then
    ExitFullscreen
  else if FZoomFactor <> 1.0 then
  begin
    FZoomFactor := 1.0;
    ApplyZoom;
  end
  else
    ToggleFullscreen;
end;

end.

uThumbnailForm.pas
[Delphi] 纯文本查看 复制代码
unit uThumbnailForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TfrmThumbnail = class(TForm)
  private
    FImageFile: string;
    FImage: TImage;
    FLblInfo: TLabel;
    FLblBottom: TLabel;
    FBtnOpen: TButton;
    procedure BtnOpenClick(Sender: TObject);
    procedure LoadThumbnail(const AFileName: string);
    function GetFileSizeStr(const AFileName: string): string;
    function GetBitDepthStr(Pic: TPicture): string;
    procedure WMTimer(var Msg: TMessage); message WM_TIMER;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN;
  public
    constructor Create(AOwner: TComponent); override;
    procedure ShowAt(const AFileName: string; const ScreenPt: TPoint);
  end;

const
  TIMER_RAISE = 1;
  TIMER_CHECK = 2;

implementation

uses
  Vcl.Imaging.Jpeg, Vcl.Imaging.PngImage, Vcl.Imaging.GIFImg;

const
  MAX_THUMB = 256;
  RAISE_DELAY = 120;
  CHECK_INTERVAL = 200;
  BAR_HEIGHT = 22;

constructor TfrmThumbnail.Create(AOwner: TComponent);
begin
  inherited CreateNew(AOwner);

  FImage := TImage.Create(Self);
  FImage.Parent := Self;
  FImage.Align := alClient;
  FImage.Center := True;
  FImage.Stretch := True;
  FImage.Proportional := True;

  FLblInfo := TLabel.Create(Self);
  FLblInfo.Parent := Self;
  FLblInfo.Align := alTop;
  FLblInfo.AutoSize := False;
  FLblInfo.Height := BAR_HEIGHT;
  FLblInfo.Color := clBlack;
  FLblInfo.Font.Color := clLime;
  FLblInfo.Font.Size := 9;
  FLblInfo.Alignment := taCenter;
  FLblInfo.Layout := tlCenter;
  FLblInfo.Caption := '';

  FLblBottom := TLabel.Create(Self);
  FLblBottom.Parent := Self;
  FLblBottom.Align := alBottom;
  FLblBottom.AutoSize := False;
  FLblBottom.Height := BAR_HEIGHT;
  FLblBottom.Color := clBlack;
  FLblBottom.Font.Color := clLime;
  FLblBottom.Font.Size := 9;
  FLblBottom.Alignment := taCenter;
  FLblBottom.Layout := tlCenter;
  FLblBottom.Caption := '';

  FBtnOpen := TButton.Create(Self);
  FBtnOpen.Parent := Self;
  FBtnOpen.Caption := '关闭';
  FBtnOpen.Align := alBottom;
  FBtnOpen.OnClick := BtnOpenClick;

  BorderStyle := bsNone;
  BorderIcons := [];
  FormStyle := fsStayOnTop;
  Color := clBlack;
  DoubleBuffered := True;
  ClientWidth := MAX_THUMB + 8;
  ClientHeight := MAX_THUMB + 8 + BAR_HEIGHT * 2 + FBtnOpen.Height;
end;

procedure TfrmThumbnail.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.WndParent := GetDesktopWindow;
  Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW or WS_EX_NOACTIVATE or WS_EX_TOPMOST;
end;

procedure TfrmThumbnail.WMKeyDown(var Msg: TWMKeyDown);
begin
  if Msg.CharCode = VK_ESCAPE then
    Release
  else
    inherited;
end;

procedure TfrmThumbnail.WMTimer(var Msg: TMessage);
var
  Pt: TPoint;
begin
  case Msg.WParam of
    TIMER_RAISE:
      begin
        KillTimer(Handle, TIMER_RAISE);
        SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
        RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW);
        SetTimer(Handle, TIMER_CHECK, CHECK_INTERVAL, nil);
      end;
    TIMER_CHECK:
      begin
        if FindWindow('#32768', nil) <> 0 then
          Exit;
        GetCursorPos(Pt);
        if (Pt.X >= Left) and (Pt.X < Left + Width) and (Pt.Y >= Top) and (Pt.Y < Top + Height) then
          Exit;
        KillTimer(Handle, TIMER_CHECK);
        Release;
      end;
  end;
end;

function TfrmThumbnail.GetFileSizeStr(const AFileName: string): string;
var
  F: file;
begin
  AssignFile(F, AFileName);
  Reset(F, 1);
  try
    if FileSize(F) < 1024 then
      Result := Format('%d B', [FileSize(F)])
    else if FileSize(F) < 1024 * 1024 then
      Result := Format('%.1f KB', [FileSize(F) / 1024])
    else
      Result := Format('%.1f MB', [FileSize(F) / (1024 * 1024)]);
  finally
    CloseFile(F);
  end;
end;

function TfrmThumbnail.GetBitDepthStr(Pic: TPicture): string;
var
  Bmp: TBitmap;
begin
  if Pic.Graphic is TJPEGImage then
    Result := '24'
  else if Pic.Graphic is TPNGImage then
    Result := IntToStr(TPNGImage(Pic.Graphic).Header.BitDepth)
  else if Pic.Graphic is TBitmap then
  begin
    case TBitmap(Pic.Graphic).PixelFormat of
      pf1bit:
        Result := '1';
      pf4bit:
        Result := '4';
      pf8bit:
        Result := '8';
      pf15bit:
        Result := '15';
      pf16bit:
        Result := '16';
      pf24bit:
        Result := '24';
      pf32bit:
        Result := '32';
      pfCustom:
        Result := '?';
    else
      Result := '?';
    end;
  end
  else if Pic.Graphic is TGIFImage then
    Result := '8'
  else
    Result := '?';
  Result := Result + ' 位';
end;

procedure TfrmThumbnail.LoadThumbnail(const AFileName: string);
var
  Pic: TPicture;
  DimStr, SizeStr, ExtStr, DepthStr: string;
begin
  if not FileExists(AFileName) then
    Exit;
  Pic := TPicture.Create;
  try
    Pic.LoadFromFile(AFileName);
    FImageFile := AFileName;
    FImage.Picture.Assign(Pic);

    DimStr := Format('%d x %d', [Pic.Width, Pic.Height]);
    SizeStr := GetFileSizeStr(AFileName);
    FLblInfo.Caption := DimStr + '  ' + SizeStr;

    DepthStr := GetBitDepthStr(Pic);
    ExtStr := UpperCase(ExtractFileExt(AFileName));
    FLblBottom.Caption := DepthStr + '  ' + ExtStr;
  finally
    Pic.Free;
  end;
end;

procedure TfrmThumbnail.ShowAt(const AFileName: string; const ScreenPt: TPoint);
var
  W, H: Integer;
begin
  LoadThumbnail(AFileName);
  W := Width;
  H := Height;
  Left := ScreenPt.X + 20;
  Top := ScreenPt.Y - H div 4;
  if Left + W > Screen.DesktopWidth then
    Left := ScreenPt.X - W - 10;
  if Top + H > Screen.DesktopHeight then
    Top := Screen.DesktopHeight - H - 10;
  if Top < 0 then
    Top := 0;
  ShowWindow(Handle, SW_SHOWNOACTIVATE);
  SetTimer(Handle, TIMER_RAISE, RAISE_DELAY, nil);
end;

procedure TfrmThumbnail.BtnOpenClick(Sender: TObject);
begin
  Release;
end;

end.

发帖前要善用【论坛搜索】功能，那里可能会有你要找的答案或者已经有人发布过相同内容了，请勿重复发帖。
回复

举报

冥界3大法王
 楼主| 冥界3大法王 发表于 2026-5-8 16:55
本帖最后由 冥界3大法王 于 2026-5-8 17:20 编辑

最后Shift+F9 在delphi中编译成DLL，并用regsvr32 注册一下
编译是x86/x64要看你的系统位数，否则Explorer菜单项里找不到哟~~

PicaViewShell.dpr
[Pascal] 纯文本查看 复制代码
library PicaViewShell;

uses
  ComServ,
  uShellExt in 'uShellExt.pas',
  uThumbnailForm in 'uThumbnailForm.pas',
  ImageViewerForm in 'ImageViewerForm.pas';

{$R *.res}

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

begin
end.
【吾爱破解论坛总版规】 - [让你充分了解吾爱破解论坛行为规则]
回复

举报

af8889
af8889 发表于 2026-5-8 17:52
吾爱破解论坛没有任何官方QQ群，禁止留联系方式，禁止任何商业交易。
感谢大神分享好工具！期待成品
如何升级？如何获得积分？积分对应解释说明！
回复

举报

冥界3大法王
 楼主| 冥界3大法王 发表于 2026-5-8 17:59
《站点帮助文档》有什么问题来这里看看吧，这里有你想知道的内容！
af8889 发表于 2026-5-8 17:52
感谢大神分享好工具！期待成品

Shift+F9就有了，全部源码啊。
呼吁大家发布原创作品添加吾爱破解论坛标识！
回复

举报

af8889
af8889 发表于 2026-5-8 18:03
冥界3大法王 发表于 2026-5-8 17:59
Shift+F9就有了，全部源码啊。

我不会，所以期待生成好的成品软件，直接用的那种
如何快速判断一个文件是否为病毒！
回复

举报

sztoplon
sztoplon 发表于 2026-5-8 18:09
看着这熟悉的begin end，仿佛又回到了大学时代

回复

举报

完美坏坏
完美坏坏 发表于 2026-5-8 18:15
拜膜大神。现在用delphi写代码的不多了吧，30年前才是它的光辉时刻！前面记得delphi不更新了，后来又卖了，再后来就没有了解过了，现在还更新吗？
回复

举报

冥界3大法王
 楼主| 冥界3大法王 发表于 2026-5-8 19:19
完美坏坏 发表于 2026-5-8 18:15
拜膜大神。现在用delphi写代码的不多了吧，30年前才是它的光辉时刻！前面记得delphi不更新了，后来又卖了， ...

@完美坏坏
活得妥妥的啊。而且已经升级到了全平台编译输出，最新13.2好像是。编译输出32位和64位的程序。
支持安卓开发，IOS开发，Linux开发。
譬如当年人家知名的诺顿依然牛逼和坚挺，而国产的那些饭桶玩意早已完蛋并堕落成了流氓软件。
虽然我们老了，但记忆和经验却保留了下来，虽然有些已经完犊子了。
但却被新的东西却继承和取代。
回复

举报

kenxy
kenxy 发表于 2026-5-8 19:50
可以哦，真的可以耶！在支持的图片格式文件上，鼠标右键就能出来图片和右键菜单，但是图片挡住菜单，选择用PicaView查看，我电脑的浏览器卡住了
回复

举报

HUIANG
HUIANG 发表于 2026-5-8 22:48
这是修炼成功了，写出相关可用的软件了。
回复

举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册[Register]

本版积分规则


免责声明：
吾爱破解所发布的一切破解补丁、注册机和注册信息及软件的解密分析文章仅限用于学习和研究目的；不得将上述内容用于商业或者非法用途，否则，一切后果请用户自负。本站信息来自网络，版权争议与本站无关。您必须在下载后的24个小时之内，从您的电脑中彻底删除上述内容。如果您喜欢该程序，请支持正版软件，购买注册，得到更好的正版服务。如有侵权请邮件与我们联系处理。

Mail To:Service@52pojie.cn

返回列表

RSS订阅|小黑屋|处罚记录|联系我们|吾爱破解 - 52pojie.cn ( 京ICP备16042023号 | 京公网安备 11010502030087号 )

GMT+8, 2026-5-9 10:26

Powered by Discuz!

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表