jvwindialogs.pas

East make Tray Icon in delphi

    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;

{$IFDEF VCL}

//=== { TJvOpenDialog2000 } ==================================================

function TJvOpenDialog2000.Execute: Boolean;
begin
  if (Win32MajorVersion >= 5) and (Win32Platform = VER_PLATFORM_WIN32_NT) then
    Result := DoExecute(@OpenInterceptor)
  else
    Result := inherited Execute;
end;

//=== { TJvSaveDialog2000 } ==================================================

function TJvSaveDialog2000.Execute: Boolean;
begin
  if (Win32MajorVersion >= 5) and (Win32Platform = VER_PLATFORM_WIN32_NT) then
    Result := DoExecute(@SaveInterceptor)
  else
    Result := inherited Execute;
end;

{$ENDIF VCL}

//=== { 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
      {$IFDEF VCL}
      Result := F.Handle;
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      Result := QWidget_winId(F.Handle);
      {$ENDIF VisualCLX}
  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
      {$IFDEF VCL}
      Result := F.Handle;
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      Result := QWidget_winId(F.Handle);
      {$ENDIF VisualCLX}
  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;

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

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

end.