* Fixed Mantis #5956: TJvEdit triggers "Feature Not Implemented" erro…

…r on 64 bit version * Removed ShellMessageBox function that was unofficial prior to XP and discontinued with XP SP3. * Removed ChangeTopException. Use AcquireExceptionObject instead of hacking the exception handling. * Fixed/Removed all DELPHI64_TEMPORARY ifdefs
project-jedi · Aug 16, 2012 · 89165cb · 89165cb
1 parent bf9abbc
commit 89165cb
Show file tree

Hide file tree

Showing 14 changed files with 62 additions and 204 deletions.
diff --git a/jvcl/HooksAndHacks.txt b/jvcl/HooksAndHacks.txt
@@ -16,3 +16,5 @@ JvDSADialog:
 JvBandObject:
   * MakeMsgHookInstance creates a helper function in memory that injects the hidden Self parameter (x64 ready)
 
+JvPageSetup:
+  * THackCommonDialog, hard typecast to get access to private fields
diff --git a/jvcl/run/DBT.pas b/jvcl/run/DBT.pas
@@ -53,7 +53,7 @@ interface
 (*$HPPEMIT '' *)
 
 uses
-  Windows;
+  Windows, Messages;
 
 { *
   * BroadcastSpecialMessage constants
@@ -571,10 +571,13 @@   DEV_BROADCAST_USERDEFINED = record
 
 type
   TWMDeviceChange = record
-   Msg:    Cardinal;
-   Event:  {$IFDEF DELPHI64_TEMPORARY}WPARAM{$ELSE}UINT{$ENDIF};
-   dwData: Pointer;
-   Result: LRESULT;
+    Msg: Cardinal;
+    {$IFDEF COMPILER16_UP}
+    MsgFiller: TDWordFiller;
+    {$ENDIF COMPILER16_UP}
+    Event: WPARAM;
+    dwData: Pointer;
+    Result: LRESULT;
   end;
 
 implementation

diff --git a/jvcl/run/JvCaptionButton.pas b/jvcl/run/JvCaptionButton.pas
@@ -332,8 +332,12 @@ implementation
   GMsimg32Handle: THandle = 0;
   GTriedLoadMsimg32Dll: Boolean = False;
 
-  _AlphaBlend: Pointer;
-  _TransparentBlt: Pointer;
+  _AlphaBlend: function(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest,
+    nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc,
+    nHeightSrc: Integer; BlendFunction: BLENDFUNCTION): BOOL; stdcall;
+  _TransparentBlt: function(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest, hHeightDest: Integer;
+    hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc: Integer;
+    crTransparent: UINT): BOOL; stdcall;
 
 {$IFDEF JVCLThemesEnabled}
 
@@ -511,8 +515,8 @@ procedure PreMultiplyAlphaChannel(Data: PRGBQuad; Count: Integer);
 
 procedure UnloadMsimg32Dll;
 begin
-  _TransparentBlt := nil;
-  _AlphaBlend := nil;
+  @_TransparentBlt := nil;
+  @_AlphaBlend := nil;
   if GMsimg32Handle > 0 then
     FreeLibrary(GMsimg32Handle);
   GMsimg32Handle := 0;
@@ -524,8 +528,8 @@ procedure LoadMsimg32Dll;
   GMsimg32Handle := SafeLoadLibrary(Msimg32DLLName);
   if GMsimg32Handle <> 0 then
   begin
-    _TransparentBlt := GetProcAddress(GMsimg32Handle, TransparentBltName);
-    _AlphaBlend := GetProcAddress(GMsimg32Handle, AlphaBlendName);
+    @_TransparentBlt := GetProcAddress(GMsimg32Handle, TransparentBltName);
+    @_AlphaBlend := GetProcAddress(GMsimg32Handle, AlphaBlendName);
   end;
 end;
 
@@ -707,38 +711,26 @@ function GetXPCaptionButtonBitmap(ABitmap: TBitmapAdapter; out BitmapCount: Inte
 
 //=== Global procedures ======================================================
 
-function AlphaBlend;
+function AlphaBlend(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest,
+  nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc,
+  nHeightSrc: Integer; BlendFunction: BLENDFUNCTION): BOOL; stdcall;
 begin
   if not GTriedLoadMsimg32Dll then
     LoadMsimg32Dll;
-  Result := Assigned(_AlphaBlend);
-  {$IFDEF DELPHI64_TEMPORARY}
-  System.Error(rePlatformNotImplemented);
-  {$ELSE ~DELPHI64_TEMPORARY}
-  if Result then
-    asm
-      mov esp, ebp
-      pop ebp
-      jmp [_AlphaBlend]
-    end;
-  {$ENDIF ~DELPHI64_TEMPORARY}
+  Result := Assigned(_AlphaBlend) and
+    _AlphaBlend(hdcDest, nXOriginDest, nYOriginDest, nWidthDest, nHeightDest, hdcSrc,
+      nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc, BlendFunction);
 end;
 
-function TransparentBlt;
+function TransparentBlt(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest, hHeightDest: Integer;
+  hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc: Integer;
+  crTransparent: UINT): BOOL; stdcall;
 begin
   if not GTriedLoadMsimg32Dll then
     LoadMsimg32Dll;
-  Result := Assigned(_TransparentBlt);
-  {$IFDEF DELPHI64_TEMPORARY}
-  System.Error(rePlatformNotImplemented);
-  {$ELSE ~DELPHI64_TEMPORARY}
-  if Result then
-    asm
-      mov esp, ebp
-      pop ebp
-      jmp [_TransparentBlt]
-    end;
-  {$ENDIF ~DELPHI64_TEMPORARY}
+  Result := Assigned(_TransparentBlt) and
+    _TransparentBlt(hdcDest, nXOriginDest, nYOriginDest, nWidthDest, hHeightDest, hdcSrc,
+      nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc, crTransparent);
 end;
 
 {$IFDEF JVCLThemesEnabled}
@@ -1171,7 +1163,7 @@ procedure TGlobalXPData.RemoveClient;
 
 procedure TGlobalXPData.Update;
 begin
-  FIsThemed := ThemeServices.{$IFDEF RTL230_UP}Available{$ELSE}ThemesAvailable{$ENDIF RTL230_UP} and IsThemeActive and IsAppThemed;
+  FIsThemed := StyleServices.Available and IsThemeActive and IsAppThemed;
   if not FIsThemed then
     Exit;
 
@@ -2646,7 +2638,7 @@ function TJvCaptionButton.WndProcAfter(var Msg: TMessage): Boolean;
         { force theme data refresh, needed when
 
           * Non-themed application and switching system font size }
-        if not ThemeServices.{$IFDEF RTL230_UP}Enabled{$ELSE}ThemesEnabled{$ENDIF RTL230_UP} then
+        if not StyleServices.Enabled then
           ThemeServices.UpdateThemes;
         {$ENDIF JVCLThemesEnabled}
       end;

diff --git a/jvcl/run/JvComputerInfoEx.pas b/jvcl/run/JvComputerInfoEx.pas
@@ -163,7 +163,10 @@   EJVCLComputerInfoEx = class(EJVCLException);
 
   TWMDeviceChange = record
     Msg: Cardinal;
-    Event: {$IFDEF DELPHI64_TEMPORARY}WPARAM{$ELSE}UINT{$ENDIF};
+    {$IFDEF COMPILER16_UP}
+    MsgFiller: TDWordFiller;
+    {$ENDIF COMPILER16_UP}
+    Event: WPARAM;
     dwData: Pointer;
     Result: LRESULT;
   end;

diff --git a/jvcl/run/JvFixedEditPopUp.pas b/jvcl/run/JvFixedEditPopUp.pas
@@ -281,25 +281,9 @@ procedure THiddenPopupObject.DoUndo(Sender: TObject);
 function THiddenPopupObject.GetClipboardCommands: TJvClipboardCommands;
 const
   cClipboardCommands = 'ClipboardCommands';
-{$IFNDEF DELPHI64_TEMPORARY}
-var
-  Value: TIntegerSet;
-  I: Integer;
-{$ENDIF ~DELPHI64_TEMPORARY}
 begin
   if IsPublishedProp(Edit, cClipboardCommands) then
-  begin
-    Result := [];
-    {$IFDEF DELPHI64_TEMPORARY}
-    System.Error(rePlatformNotImplemented);
-    {$ELSE ~DELPHI64_TEMPORARY}
-    // does it really have to be this complicated ?!
-    Value := TIntegerSet(GetOrdProp(Edit, cClipboardCommands));
-    for I := 0 to SizeOf(Integer) * 8 - 1 do
-      if I in Value then
-        Include(Result, TJvClipboardCommand(I));
-    {$ENDIF ~DELPHI64_TEMPORARY}
-  end
+    Result := TJvClipboardCommands(Byte(GetOrdProp(Edit, cClipboardCommands)))
   else
     Result := [caCopy, caCut, caPaste, caUndo];
 end;

diff --git a/jvcl/run/JvInterpreter_JvUtils.pas b/jvcl/run/JvInterpreter_JvUtils.pas
@@ -811,13 +811,6 @@ procedure JvInterpreter_IntPower(var Value: Variant; Args: TJvInterpreterArgs);
   Value := IntPower(Args.Values[0], Args.Values[1]);
 end;
 
-{ function ChangeTopException(E: TObject): TObject; }
-
-procedure JvInterpreter_ChangeTopException(var Value: Variant; Args: TJvInterpreterArgs);
-begin
-  Value := O2V(ChangeTopException(V2O(Args.Values[0])));
-end;
-
 { function MakeValidFileName(const FileName: TFileName; const ReplaceBadChar: Char): TFileName; }
 
 procedure JvInterpreter_MakeValidFileName(var Value: Variant; Args: TJvInterpreterArgs);
@@ -1058,7 +1051,6 @@ procedure RegisterJvInterpreterAdapter(JvInterpreterAdapter: TJvInterpreterAdapt
     AddFunction(cJvUtils, 'SwapInt', JvInterpreter_SwapInt, 2, [varInteger or varByRef, varInteger or varByRef],
       varEmpty);
     AddFunction(cJvUtils, 'IntPower', JvInterpreter_IntPower, 2, [varInteger, varInteger], varEmpty);
-    AddFunction(cJvUtils, 'ChangeTopException', JvInterpreter_ChangeTopException, 1, [varObject], varEmpty);
     AddFunction(cJvUtils, 'MakeValidFileName', JvInterpreter_MakeValidFileName, 2, [varEmpty, varEmpty], varEmpty);
     AddFunction(cJvUtils, 'AnsiStrLIComp', JvInterpreter_AnsiStrLIComp, 3, [varEmpty, varEmpty, varEmpty], varEmpty);
     AddFunction(cJvUtils, 'Var2Type', JvInterpreter_Var2Type, 2, [varEmpty, varInteger], varEmpty);

diff --git a/jvcl/run/JvJCLUtils.pas b/jvcl/run/JvJCLUtils.pas
@@ -326,7 +326,6 @@ function PrettyNameToColor(const Value: string): TColor;
 {**** other routines }
 procedure SwapInt(var Int1, Int2: Integer); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
 function IntPower(Base, Exponent: Integer): Integer;
-function ChangeTopException(E: TObject): TObject; // Linux version writes error message to ErrOutput
 function StrToBool(const S: string): Boolean;
 
 function Var2Type(V: Variant; const DestVarType: Integer): Variant;
@@ -2442,47 +2441,6 @@ function IntPower(Base, Exponent: Integer): Integer;
     Result := 1;
 end;
 
-function ChangeTopException(E: TObject): TObject;
-type
-  PRaiseFrame = ^TRaiseFrame;
-  TRaiseFrame = record
-    NextRaise: PRaiseFrame;
-    ExceptAddr: Pointer;
-    ExceptObject: TObject;
-    //ExceptionRecord: PExceptionRecord;
-  end;
-begin
-  {$IFDEF DELPHI64_TEMPORARY}
-  System.Error(rePlatformNotImplemented);
-  Result := E;
-  {$ELSE ~DELPHI64_TEMPORARY}
-  { C++ Builder 3 Warning !}
-  { if linker error occured with message "unresolved external 'System::RaiseList'" try
-    comment this function implementation, compile,
-    then uncomment and compile again. }
-  {$IFDEF MSWINDOWS}
-  {$IFDEF SUPPORTS_DEPRECATED}
-  {$WARN SYMBOL_DEPRECATED OFF}
-  {$ENDIF SUPPORTS_DEPRECATED}
-  if RaiseList <> nil then
-  begin
-    Result := PRaiseFrame(RaiseList)^.ExceptObject;
-    PRaiseFrame(RaiseList)^.ExceptObject := E
-  end
-  else
-    Result := nil;
-  {$IFDEF SUPPORTS_DEPRECATED}
-  {$WARN SYMBOL_DEPRECATED ON}
-  {$ENDIF SUPPORTS_DEPRECATED}
-  {$ENDIF MSWINDOWS}
-  {$IFDEF UNIX}
-  // XXX: changing exception in stack frame is not supported on Kylix
-  Writeln(ErrOutput, 'ChangeTopException');
-  Result := E;
-  {$ENDIF UNIX}
-  {$ENDIF ~DELPHI64_TEMPORARY}
-end;
-
 function KeyPressed(VK: Integer): Boolean;
 begin
   Result := Windows.GetKeyState(VK) and $8000 = $8000;
@@ -7548,15 +7506,10 @@ procedure ResourceNotFound(ResID: PChar);
 var
   S: string;
 begin
-  {$IFDEF DELPHI64_TEMPORARY}
-  if INT_PTR(ResID) <= $FFFF then
+  if DWORD_PTR(ResID) <= $FFFF then
     S := IntToStr(INT_PTR(ResID))
-  {$ELSE ~DELPHI64_TEMPORARY}
-  if LongRec(ResID).Hi = 0 then
-    S := IntToStr(LongRec(ResID).Lo)
-  {$ENDIF ~DELPHI64_TEMPORARY}
   else
-    S := StrPas(ResID);
+    S := ResID;
   raise EResNotFound.CreateResFmt(@SResNotFound, [S]);
 end;
 

diff --git a/jvcl/run/JvJVCLUtils.pas b/jvcl/run/JvJVCLUtils.pas
@@ -1533,13 +1533,8 @@ function MakeModuleBitmap(Module: THandle; ResID: PChar): TBitmap;
   try
     if Module <> 0 then
     begin
-      {$IFDEF DELPHI64_TEMPORARY}
-      if INT_PTR(ResID) <= $FFFF then
+      if DWORD_PTR(ResID) <= $FFFF then
         Result.LoadFromResourceID(Module, INT_PTR(ResID))
-      {$ELSE ~DELPHI64_TEMPORARY}
-      if LongRec(ResID).Hi = 0 then
-        Result.LoadFromResourceID(Module, LongRec(ResID).Lo)
-      {$ENDIF ~DELPHI64_TEMPORARY}
       else
         Result.LoadFromResourceName(Module, StrPas(ResID));
     end

diff --git a/jvcl/run/JvPageSetup.pas b/jvcl/run/JvPageSetup.pas
@@ -32,6 +32,7 @@ interface
   JclUnitVersioning,
   {$ENDIF UNITVERSIONING}
   Windows, Classes, Messages, Graphics, CommDlg, Dialogs,
+  JclBase,
   JvBaseDlg;
 
 const
@@ -269,7 +270,7 @@ procedure CenterWindow(Wnd: HWND);
 // Generic dialog hook. Centers the dialog on the screen in response to
 // the WM_INITDIALOG message
 
-function DialogHook(Wnd: HWND; Msg: UINT; AWParam: WPARAM; ALParam: LPARAM): {$IFDEF RTL230_UP}UINT_PTR{$ELSE}UINT{$ENDIF RTL230_UP}; stdcall;
+function DialogHook(Wnd: HWND; Msg: UINT; AWParam: WPARAM; ALParam: LPARAM): UINT_PTR; stdcall;
 begin
   Result := 0;
   if Msg = WM_INITDIALOG then
@@ -283,7 +284,7 @@ function DialogHook(Wnd: HWND; Msg: UINT; AWParam: WPARAM; ALParam: LPARAM): {$I
   end;
 end;
 
-function PageDrawHook(Wnd: HWND; Msg: UINT; AWParam: WPARAM; ALParam: LPARAM): {$IFDEF RTL230_UP}UINT_PTR{$ELSE}UINT{$ENDIF RTL230_UP}; stdcall;
+function PageDrawHook(Wnd: HWND; Msg: UINT; AWParam: WPARAM; ALParam: LPARAM): UINT_PTR; stdcall;
 const
   PagePaintWhat: array [WM_PSD_FULLPAGERECT..WM_PSD_YAFULLPAGERECT] of TJvPSPaintWhat =
    (pwFullPage, pwMinimumMargins, pwMargins,
@@ -355,7 +356,7 @@ procedure SetPrinter(DeviceMode, DeviceNames: THandle);
 
 function CopyData(Handle: THandle): THandle;
 var
-  Src, Dest: {$IFDEF COMPILER12_UP}PByte{$ELSE}PChar{$ENDIF COMPILER12_UP};
+  Src, Dest: PByte;
   Size: Integer;
 begin
   if Handle <> 0 then
@@ -491,8 +492,7 @@ procedure TJvPageSetupDialog.WMCommand(var Msg: TWMCommand);
 const
   IDPRINTERBTN = $0402;
 begin
-  if not ((Msg.ItemID = IDPRINTERBTN) and
-    (Msg.NotifyCode = BN_CLICKED) and DoPrinter) then
+  if not ((Msg.ItemID = IDPRINTERBTN) and (Msg.NotifyCode = BN_CLICKED) and DoPrinter) then
     inherited;
 end;
 
@@ -548,32 +548,32 @@ function TJvPageSetupDialog.TaskModalDialog(DialogFunc: Pointer; var DialogData)
 var
   ActiveWindow: HWND;
   WindowList: Pointer;
-  {$IFNDEF DELPHI64_TEMPORARY}
+  {$IFDEF CPU86}
   FPUControlWord: Word;
-  {$ENDIF ~DELPHI64_TEMPORARY}
+  {$ENDIF CPU86}
 begin
   ActiveWindow := GetActiveWindow;
   WindowList := DisableTaskWindows(0);
   try
     Application.HookMainWindow(MessageHook);
-    {$IFNDEF DELPHI64_TEMPORARY}
+    {$IFDEF CPU86}
     asm
       // Avoid FPU control word change in NETRAP.dll, NETAPI32.dll, etc
       FNSTCW  FPUControlWord
     end;
-    {$ENDIF ~DELPHI64_TEMPORARY}
+    {$ENDIF CPU86}
     try
       CreationControl := Self;
       PageSetupControl := Self;
       Result := TDialogFunc(DialogFunc)(DialogData);
     finally
       PageSetupControl := nil;
-      {$IFNDEF DELPHI64_TEMPORARY}
+      {$IFDEF CPU86}
       asm
         FNCLEX
         FLDCW FPUControlWord
       end;
-      {$ENDIF ~DELPHI64_TEMPORARY}
+      {$ENDIF CPU86}
       Application.UnhookMainWindow(MessageHook);
     end;
   finally

diff --git a/jvcl/run/JvProgressComponent.pas b/jvcl/run/JvProgressComponent.pas
@@ -262,10 +262,7 @@ procedure TJvProgressForm.CMShowEvent(var Msg: TCMShowEvent);
 //      (Owner as TJvProgressComponent).FOnShow(Self);
     except
       on E: Exception do
-      begin
-        (Owner as TJvProgressComponent).FException := E;
-        ChangeTopException(nil);
-      end;
+        (Owner as TJvProgressComponent).FException := AcquireExceptionObject;
     end;
   finally
     ModalResult := mrOk;