jvqwindialogs.pas

East make Tray Icon in delphi

  if Desc <> '' then
    OleCheck(SL.SetDescription(PChar(Desc))); // set description
  { create a path location and filename for link file }
  LnkName := GetSpecialFolderPath(Dest, True) + '\' +
    ChangeFileExt(AppName, 'lnk');
  PF.Save(PWideChar(LnkName), True); // save link file
  Result := LnkName;
end;

procedure GetShellLinkInfo(const LinkFile: WideString; var SLI: TShellLinkInfo);
{ Retrieves information on an existing shell link }
var
  SL: IShellLink;
  PF: IPersistFile;
  FindData: TWin32FindData;
  AStr: array [0..MAX_PATH] of Char;
begin
  OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
    IShellLink, SL));
  { The IShellLink implementer must also support the IPersistFile }
  { interface. Get an interface pointer to it. }
  PF := SL as IPersistFile;
  { Load file into IPersistFile object }
  OleCheck(PF.Load(PWideChar(LinkFile), STGM_READ));
  { Resolve the link by calling the Resolve interface function. }
  OleCheck(SL.Resolve(0, SLR_ANY_MATCH or SLR_NO_UI));
  { Get all the info! }
  with SLI do
  begin
    OleCheck(SL.GetPath(AStr, MAX_PATH, FindData, SLGP_SHORTPATH));
    PathName := AStr;
    OleCheck(SL.GetArguments(AStr, MAX_PATH));
    Arguments := AStr;
    OleCheck(SL.GetDescription(AStr, MAX_PATH));
    Description := AStr;
    OleCheck(SL.GetWorkingDirectory(AStr, MAX_PATH));
    WorkingDirectory := AStr;
    OleCheck(SL.GetIconLocation(AStr, MAX_PATH, IconIndex));
    IconLocation := AStr;
    OleCheck(SL.GetShowCmd(ShowCmd));
    OleCheck(SL.GetHotKey(HotKey));
  end;
end;

procedure SetShellLinkInfo(const LinkFile: WideString;
  const SLI: TShellLinkInfo);
{ Sets information for an existing shell link }
var
  SL: IShellLink;
  PF: IPersistFile;
begin
  OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
    IShellLink, SL));
  { The IShellLink implementer must also support the IPersistFile }
  { interface. Get an interface pointer to it. }
  PF := SL as IPersistFile;
  { Load file into IPersistFile object }
  OleCheck(PF.Load(PWideChar(LinkFile), STGM_SHARE_DENY_WRITE));
  { Resolve the link by calling the Resolve interface function. }
  OleCheck(SL.Resolve(0, SLR_ANY_MATCH or SLR_UPDATE or SLR_NO_UI));
  { Set all the info! }
  with SLI, SL do
  begin
    OleCheck(SetPath(PChar(PathName)));
    OleCheck(SetArguments(PChar(Arguments)));
    OleCheck(SetDescription(PChar(Description)));
    OleCheck(SetWorkingDirectory(PChar(WorkingDirectory)));
    OleCheck(SetIconLocation(PChar(IconLocation), IconIndex));
    OleCheck(SetShowCmd(ShowCmd));
    OleCheck(SetHotKey(HotKey));
  end;
  PF.Save(PWideChar(LinkFile), True); // save file
end;

function RecycleFile(FileToRecycle: string): Boolean;
var
  OpStruct: TSHFileOpStruct;
  PFromC: PChar;
  ResultVal: Integer;
begin
  if not FileExists(FileToRecycle) then
  begin
    RecycleFile := False;
    Exit;
  end
  else
  begin
    PFromC := PChar(ExpandFileName(FileToRecycle) + #0#0);
    OpStruct.Wnd := 0;
    OpStruct.wFunc := FO_DELETE;
    OpStruct.pFrom := PFromC;
    OpStruct.pTo := nil;
    OpStruct.fFlags := FOF_ALLOWUNDO;
    OpStruct.fAnyOperationsAborted := False;
    OpStruct.hNameMappings := nil;
    ResultVal := ShFileOperation(OpStruct);
    RecycleFile := (ResultVal = 0);
  end;
end;

function CopyFile(FromFile, ToDir: string): Boolean;
var
  F: TSHFileOpStruct;
begin
  F.Wnd := 0;
  F.wFunc := FO_COPY;
  FromFile := FromFile + #0;
  F.pFrom := PChar(FromFile);
  ToDir := ToDir + #0;
  F.pTo := PChar(ToDir);
  F.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
  Result := ShFileOperation(F) = 0;
end;

// (rom) ExecuteApplet function removed

//=== { TJvOpenWithDialog } ==================================================

procedure TJvOpenWithDialog.Execute;
begin
  SHOpenWith(0, 0, PChar(FileName), SW_SHOW);
end;

//=== { TJvDiskFullDialog } ==================================================

constructor TJvDiskFullDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  DriveChar := 'C';
end;

function TJvDiskFullDialog.GetDrive: UINT;
begin
  Result := Ord(FDriveChar) - Ord('A');
end;

function TJvDiskFullDialog.Execute: Boolean;
begin
  if not Assigned(SHHandleDiskFull) then
    raise EWinDialogError.CreateRes(@RsENotSupported);
  Result := GetDriveType(PChar(DriveChar + ':\')) = 3;
  if Result then
    SHHandleDiskFull(GetForegroundWindow, GetDrive);
  // (rom) disabled to make Result work
  //else
  //  raise EWinDialogError.CreateResFmt(@RsEUnSupportedDisk, [DriveChar]);
end;

procedure TJvDiskFullDialog.SetDriveChar(Value: Char);
begin
  Value := UpCase(Value);
  if not (Value in ['A'..'Z']) then
    raise EWinDialogError.CreateResFmt(@RsEInvalidDriveChar, [Value]);
  FDriveChar := Value;
end;

//=== { TJvExitWindowsDialog } ===============================================

procedure TJvExitWindowsDialog.Execute;
begin
  SHShutDownDialog(GetForegroundWindow);
end;

//=== { TJvChangeIconDialog } ================================================

function TJvChangeIconDialog.Execute: Boolean;
var
  Buf: array [0..MAX_PATH] of Char;
  BufW: array [0..MAX_PATH] of WideChar;
begin
  if Assigned(SHChangeIconW) then
  begin
    StringToWideChar(FileName, BufW, SizeOf(BufW));
    Result := SHChangeIconW(GetForegroundWindow, BufW, SizeOf(BufW), FIconIndex) = 1;
    if Result then
      FileName := BufW;
  end
  else
  if Assigned(SHChangeIcon) then
  begin
    StrPCopy(Buf, FileName);
    Result := SHChangeIcon(GetForegroundWindow, Buf, SizeOf(Buf), FIconIndex) = 1;
    if Result then
      FileName := Buf;
  end
  else
    raise EWinDialogError.CreateRes(@RsENotSupported);
end;

function OpenInterceptor(var DialogData: TOpenFileName): BOOL; stdcall;
var
  DialogDataEx: TOpenFileNameEx;
begin
  Move(DialogData, DialogDataEx, SizeOf(DialogData));
  DialogDataEx.FlagsEx := 0;
  DialogDataEx.lStructSize := SizeOf(TOpenFileNameEx);
  Result := GetOpenFileNameEx(DialogDataEx);
end;

function SaveInterceptor(var DialogData: TOpenFileName): BOOL; stdcall;
var
  DialogDataEx: TOpenFileNameEx;
begin
  Move(DialogData, DialogDataEx, SizeOf(DialogData));
  DialogDataEx.FlagsEx := 0;
  DialogDataEx.lStructSize := SizeOf(TOpenFileNameEx);
  Result := GetSaveFileNameEx(DialogDataEx);
end;



//=== { TJvURLAssociationDialog } ============================================

constructor TJvURLAssociationDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOptions := [];
  FDefaultProtocol := 'http://'; // the URL property needs a protocol or the function call fails
end;

function TJvURLAssociationDialog.Execute: Boolean;
var
  dwFlags: DWORD;
  Buf: array [0..MAX_PATH] of Char;
begin
  Result := False;
  FReturnValue := S_FALSE;
  FAssociatedApp := '';
  if Pos(':', URL) < 1 then
    FURL := FDefaultProtocol + FURL;
  if Assigned(URLAssociationDialogA) then
  begin
    dwFlags := 0;
    FillChar(Buf[0], SizeOf(Buf), 0);
    if uaDefaultName in Options then
      dwFlags := dwFlags or URLASSOCDLG_FL_USE_DEFAULT_NAME;
    if uaRegisterAssoc in Options then
      dwFlags := dwFlags or URLASSOCDLG_FL_REGISTER_ASSOC;
    FReturnValue := URLAssociationDialogA(GetParentHandle, dwFlags,
      PChar(FileName), PChar(URL), Buf, SizeOf(Buf));
    Result := ReturnValue = S_OK;
    FAssociatedApp := Buf;
  end;
end;

function TJvURLAssociationDialog.GetParentHandle: THandle;
var
  F: TCustomForm;
begin
  Result := 0;
  if Owner is TControl then
  begin
    F := GetParentForm(TControl(Owner));
    if F <> nil then  
      Result := QWidget_winId(F.Handle); 
  end;
  if Result = 0 then
    Result := GetForegroundWindow;
  if Result = 0 then
    Result := GetDesktopWindow;
end;

//=== { TJvMIMEAssociationDialog } ===========================================

function TJvMIMEAssociationDialog.Execute: Boolean;
var
  dwFlags: Cardinal;
  Buf: array [0..MAX_PATH] of Char;
begin
  Result := False;
  FReturnValue := S_FALSE;
  if Assigned(MIMEAssociationDialogA) then
  begin
    FillChar(Buf[0], SizeOf(Buf), 0);
    FAssociatedApp := '';
    if maRegisterAssoc in Options then
      dwFlags := MIMEASSOCDLG_FL_REGISTER_ASSOC
    else
      dwFlags := 0;
    FReturnValue := MIMEAssociationDialogA(GetParentHandle, dwFlags,
      PChar(FileName), PChar(ContentType), Buf, SizeOf(Buf));
    Result := ReturnValue = 0;
    FAssociatedApp := Buf;
  end;
end;

function TJvMIMEAssociationDialog.GetParentHandle: THandle;
var
  F: TCustomForm;
begin
  Result := 0;
  if Owner is TControl then
  begin
    F := GetParentForm(TControl(Owner));
    if F <> nil then  
      Result := QWidget_winId(F.Handle); 
  end;
  if Result = 0 then
    Result := GetForegroundWindow;
  if Result = 0 then
    Result := GetDesktopWindow;
end;

//=== { TJvSoftwareUpdateDialog } ============================================

constructor TJvSoftwareUpdateDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDistInfo := TJvSoftwareUpdateInfo.Create;
end;

destructor TJvSoftwareUpdateDialog.Destroy;
begin
  FDistInfo.Free;
  inherited Destroy;
end;

function TJvSoftwareUpdateDialog.Execute: Boolean;
var
  psdi: TSoftDistInfo;
begin
  Result := False;
  FReturnValue := IDCANCEL;
  if Assigned(SoftwareUpdateMessageBox) then
  begin
    psdi := FDistInfo.SoftDistInfo;
    FReturnValue := SoftwareUpdateMessageBox(GetDesktopWindow, '', 0, psdi);
    Result := ReturnValue = IDYES;
    if ReturnValue <> IDABORT then
      FDistInfo.SoftDistInfo := psdi;
  end;
end;

//=== { TJvSoftwareUpdateInfo } ==============================================

function TJvSoftwareUpdateInfo.GetSoftDistInfo: TSoftDistInfo;
const
  cAdState: array [TJvSoftwareUpdateAdState] of DWORD =
   (SOFTDIST_ADSTATE_NONE, SOFTDIST_ADSTATE_AVAILABLE,
    SOFTDIST_ADSTATE_DOWNLOADED, SOFTDIST_ADSTATE_INSTALLED);
  cFlags: array [TJvSoftwareUpdateFlags] of DWORD =
   (SOFTDIST_FLAG_USAGE_EMAIL, SOFTDIST_FLAG_USAGE_PRECACHE,
    SOFTDIST_FLAG_USAGE_AUTOINSTALL, SOFTDIST_FLAG_DELETE_SUBSCRIPTION);
begin
  FillChar(Result, SizeOf(Result), 0);
  Result.cbSize := SizeOf(Result);
  with Result do
  begin
    dwAdState := cAdState[AdState];
    dwFlags := cFlags[Flags];
    // (p3)_ does result from StringToOLEStr need to be freed? 
    lpszTitle := StringToOleStr(Title);
    lpszAbstract := StringToOleStr(Description);
    lpszHREF := StringToOleStr(HREF);
    dwInstalledVersionMS := InstalledVersionMS;
    dwInstalledVersionLS := InstalledVersionLS;
    dwUpdateVersionMS := UpdateVersionMS;
    dwUpdateVersionLS := UpdateVersionLS;
    dwAdvertisedVersionMS := AdvertisedVersionMS;
    dwAdvertisedVersionLS := AdvertisedVersionLS;
  end;
end;

procedure TJvSoftwareUpdateInfo.SetSoftDistInfo(const Value: TSoftDistInfo);
begin
  with Value do
  begin
    case dwAdState of
      SOFTDIST_ADSTATE_NONE:
        AdState := asNone;
      SOFTDIST_ADSTATE_AVAILABLE:
        AdState := asAvailable;
      SOFTDIST_ADSTATE_DOWNLOADED:
        AdState := asDownloaded;
      SOFTDIST_ADSTATE_INSTALLED:
        AdState := asInstalled;
    end;
    case dwFlags of
      SOFTDIST_FLAG_USAGE_EMAIL:
        Flags := ufEmail;
      SOFTDIST_FLAG_USAGE_PRECACHE:
        Flags := ufPreCache;
      SOFTDIST_FLAG_USAGE_AUTOINSTALL:
        Flags := ufAutoInstall;
      SOFTDIST_FLAG_DELETE_SUBSCRIPTION:
        Flags := ufDeleteSubscription;
    end;

    Title := lpszTitle;
    Description := lpszAbstract;
    HREF := lpszHREF;
    InstalledVersionMS := dwInstalledVersionMS;
    InstalledVersionLS := dwInstalledVersionLS;
    UpdateVersionMS := dwUpdateVersionMS;
    UpdateVersionLS := dwUpdateVersionLS;
    AdvertisedVersionMS := dwAdvertisedVersionMS;
    AdvertisedVersionLS := dwAdvertisedVersionLS;
  end;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQWinDialogs.pas,v $';
    Revision: '$Revision: 1.16 $';
    Date: '$Date: 2004/09/07 23:11:36 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}

  LoadJvDialogs;

finalization
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}
  UnloadJvDialogs;

end.