Project JEDI - Issue Tracker
Mantis Bugtracker

Viewing Issue Simple Details Jump to Notes ] View Advanced ] Issue History ] Print ]
ID Category Severity Reproducibility Date Submitted Last Update
0005644 [JEDI VCL] 00 JVCL Components major always 2011-08-27 05:01 2012-09-27 09:55
Reporter cdsaenz View Status public  
Assigned To AHUser
Priority normal Resolution fixed  
Status resolved   Product Version 3.40
Summary 0005644: TJvTabDefaultPainter painting empty text on tabs in Delphi 7
Description TJvTabDefaultPainter assigned to a JvPageControl will render empty captions on the pagecontrol's tabs in Delphi 7, under Windows 7 64 Bit.

In the same OS running in Delphi XE, the component seems to be behaving normally.
Additional Information
Tags No tags attached.
Attached Files zip file icon Problem_Example.zip [^] (5,407 bytes) 2012-08-28 16:45

- Relationships

-  Notes
(0018945)
obones (administrator)
2011-09-21 12:00

Please provide the zipped sources of a sample application showing this
(0019504)
obones (administrator)
2012-02-23 11:20

We really need a demo application to test this
(0019760)
Thor (reporter)
2012-05-16 11:40

I can confirm this bug and i add this information :
- the bug appear also at desgin time.

You don't need a demo application. Follow this simple step
and you can see with your eyes :
- open D7 under windows 7 64 bit
- start a new project
- in the form1 add a TjvPageControl
- click with the right button on the pagecontrol and add a "new page" (repeat this 3 times)
- add the TjvTabDefaultPainter
- connect the TjvDefaultPainter to the TjvPageControl (property TabPainter)

when you connect the TjvDefaultPainter the caption of the 3 page disappeared and no color is drived by the TjvDefaultPainter
(0019873)
obones (administrator)
2012-06-11 17:38

I need a sample application because I don't want to waste time following instructions. I mean, I have VERY LIMITED AVAILABLE TIME, so the less I have to work on any issue, the higher the chance it gets fixed.
(0020210)
frank_jepsen (reporter)
2012-09-24 16:24

Today I ran into the same problem on my new x64 machine.
Here I found a solution: https://forums.embarcadero.com/thread.jspa?messageID=292598 [^]

Here is a description of the problem: http://qc.embarcadero.com/wc/qcmain.aspx?d=19859 [^]

I did this patch and now it works for me:

--- a/JvComCtrls.pas
+++ b/JvComCtrls.pas
@@ -46,6 +46,7 @@ uses
   {$ENDIF UNITVERSIONING}
   Windows, Messages, Graphics, Controls, Forms,
   Classes,
+ Dialogs,
   Menus, ComCtrls, ImgList, Buttons, Types, CommCtrl,
   JvJVCLUtils, JvComponentBase, JvComponent, JvExControls, JvExComCtrls, JvWin32,
   JvDataSourceIntf;
@@ -3341,12 +3342,179 @@ begin
   end;
 end;
 
+// WMDrawItem fails under WOW64, see http://qc.codegear.com/wc/qcmain.aspx?d=19859 [^]
+
+{$IFDEF VER150}// Delphi7
+
+function GetMethodAddress(AMessageID : word; AClass : TClass; out MethodAddr : Pointer) : boolean;
+var
+ DynamicTableAddress : Pointer;
+ MethodEntry : ^Pointer;
+ MessageHandlerList : PWord;
+ EntryCount, EntryIndex : word;
+begin
+ Result := False;
+
+ DynamicTableAddress := Pointer(PInteger(integer(AClass) + vmtDynamicTable)^);
+ MessageHandlerList := PWord(DynamicTableAddress);
+ EntryCount := MessageHandlerList^;
+
+ if EntryCount > 0 then
+ for EntryIndex := EntryCount - 1 downto 0 do
+ begin
+ Inc(MessageHandlerList);
+ if (MessageHandlerList^ = AMessageID) then
+ begin
+ Inc(MessageHandlerList);
+ MethodEntry := Pointer(integer(MessageHandlerList) + 2 * (2 * EntryCount - EntryIndex) - 4);
+ MethodAddr := MethodEntry^;
+ Result := True;
+ end;
+ end;
+end;
+
+function PatchInstructionByte(MethodAddress : Pointer; ExpectedOffset : cardinal; ExpectedValue : byte; NewValue : byte) : boolean;
+var
+ BytePtr : PByte;
+ OldProtect : cardinal;
+begin
+ Result := False;
+
+ BytePtr := PByte(cardinal(MethodAddress) + ExpectedOffset);
+
+ if BytePtr^ = NewValue then
+ begin
+ Result := True;
+ Exit;
+ end;
+
+ if BytePtr^ <> ExpectedValue then
+ Exit;
+
+ if VirtualProtect(BytePtr, SizeOf(BytePtr^), PAGE_EXECUTE_READWRITE, OldProtect) then
+ begin
+ try
+ BytePtr^ := NewValue;
+ Result := True;
+ finally
+ Result := Result and VirtualProtect(BytePtr, SizeOf(BytePtr^), OldProtect, OldProtect) and FlushInstructionCache(GetCurrentProcess, BytePtr, SizeOf(BytePtr^));
+ end;
+ end;
+end;
+
+function PatchInstructionBytes(MethodAddress : Pointer; ExpectedOffset : cardinal; const ExpectedValues : array of byte; const NewValues : array of byte; const PatchedValues : array of byte) : boolean;
+var
+ BytePtr, TestPtr : PByte;
+ OldProtect, Index, PatchSize : cardinal;
+begin
+ BytePtr := PByte(cardinal(MethodAddress) + ExpectedOffset);
+
+ Result := True;
+ TestPtr := BytePtr;
+ for Index := Low(PatchedValues) to High(PatchedValues) do
+ begin
+ if TestPtr^ <> PatchedValues[Index] then
+ begin
+ Result := False;
+ Break;
+ end;
+ Inc(TestPtr);
+ end;
+
+ if Result then
+ Exit;
+
+ Result := True;
+ TestPtr := BytePtr;
+ for Index := Low(ExpectedValues) to High(ExpectedValues) do
+ begin
+ if TestPtr^ <> ExpectedValues[Index] then
+ begin
+ Result := False;
+ Exit;
+ end;
+ Inc(TestPtr);
+ end;
+
+ PatchSize := Length(NewValues) * SizeOf(byte);
+
+ if VirtualProtect(BytePtr, PatchSize, PAGE_EXECUTE_READWRITE, OldProtect) then
+ begin
+ try
+ TestPtr := BytePtr;
+ for Index := Low(NewValues) to High(NewValues) do
+ begin
+ TestPtr^ := NewValues[Index];
+ Inc(TestPtr);
+ end;
+ Result := True;
+ finally
+ Result := Result and VirtualProtect(BytePtr, PatchSize, OldProtect, OldProtect) and FlushInstructionCache(GetCurrentProcess, BytePtr, PatchSize);
+ end;
+ end;
+end;
+
+procedure PatchWinControl;
+var
+ MethodAddress : Pointer;
+begin
+ if not GetMethodAddress(WM_DRAWITEM, TWinControl, MethodAddress) then
+ begin
+ ShowMessage('Cannot find WM_DRAWITEM handler in TWinControl');
+ Exit;
+ end;
+ if (not PatchInstructionByte(MethodAddress, 13, $4, $14)) // release and package
+ and (not PatchInstructionByte(MethodAddress, 23, $4, $14)) then // debug
+ ShowMessage('Cannot patch WM_DRAWITEM');
+
+ if not GetMethodAddress(WM_COMPAREITEM, TWinControl, MethodAddress) then
+ begin
+ ShowMessage('Cannot find WM_COMPAREITEM handler in TWinControl');
+ Exit;
+ end;
+ if (not PatchInstructionByte(MethodAddress, 13, $04, $8)) // release and package
+ and (not PatchInstructionByte(MethodAddress, 23, $04, $8)) then // debug
+ ShowMessage('Cannot patch WM_COMPAREITEM handler');
+
+ if not GetMethodAddress(WM_DELETEITEM, TWinControl, MethodAddress) then
+ begin
+ ShowMessage('Cannot find WM_DELETEITEM handler in TWinControl');
+ Exit;
+ end;
+ if (not PatchInstructionByte(MethodAddress, 13, $04, $0C)) // release and package
+ and (not PatchInstructionByte(MethodAddress, 23, $04, $0C)) then // debug
+ ShowMessage('Cannot patch WM_DELETEITEM handler');
+
+ if not GetMethodAddress(WM_MEASUREITEM, TWinControl, MethodAddress) then
+ begin
+ ShowMessage('Cannot find WM_MEASUREITEM handler in TWinControl');
+ Exit;
+ end;
+ if (not PatchInstructionBytes(MethodAddress, 10, [$08, $8B], [$04, $90, $90, $90], [$04, $E8])) // release and package
+ and (not PatchInstructionBytes(MethodAddress, 20, [$08, $8B], [$04, $90, $90, $90], [$04, $E8])) then // debug
+ ShowMessage('Cannot patch WM_MEASUREITEM handler');
+end;
+
+{$ENDIF}
+
+// end of "WMDrawItem fails under WOW64" patch
+
 {$IFDEF UNITVERSIONING}
 initialization
+{$IFDEF VER150}// Delphi7
+ PatchWinControl;
+{$ENDIF}
   RegisterUnitVersion(HInstance, UnitVersioning);
 
 finalization
   UnregisterUnitVersion(HInstance);
 {$ENDIF UNITVERSIONING}
 
+{$IFNDEF UNITVERSIONING}
+initialization
+{$IFDEF VER150}// Delphi7
+ PatchWinControl;
+{$ENDIF}
+{$ENDIF UNITVERSIONING}
+
 end.
(0020211)
AHUser (developer)
2012-09-24 21:04

The JVCL is not the right place to fix VCL bugs. You can use that patch in one of your unit but I doubt that such a VCL binary patch will make it into the JVCL.
(0020213)
frank_jepsen (reporter)
2012-09-25 00:54

You are right. There is nothing to fix in JVCL.

Therefor I added a patch for Delphi 7 which fixes the error in Delphi itself. The attached file Delphi7Fix.zip includes the fixed files and there originals (from Delphi 7.0 Build 4.453).
(0020215)
frank_jepsen (reporter)
2012-09-25 08:47

I am sorry but is was late last night and I pached all functions identical which is wrong. Perhaps someone could delete the attachment.

Delphi7FixOk.zip should contain the correct files.

It contains the patched source and binaries of Controls.pas as supposed here: http://qc.embarcadero.com/wc/qcmain.aspx?d=19859 [^]

procedure TWinControl.WMCompareItem(var Message: TWMCompareItem);
begin
  if not DoControlMsg(Message.CompareItemStruct^.hwndItem, Message) then inherited;
end;

procedure TWinControl.WMDeleteItem(var Message: TWMDeleteItem);
begin
  if not DoControlMsg(Message.DeleteItemStruct^.hwndItem, Message) then inherited;
end;

procedure TWinControl.WMDrawItem(var Message: TWMDrawItem);
begin
  if not DoControlMsg(Message.DrawItemStruct^.hwndItem, Message) then inherited;
end;

procedure TWinControl.WMMeasureItem(var Message: TWMMeasureItem);
begin
  if not DoControlMsg(Message.IDCtl, Message) then inherited;
end;

This is the way it is implemented in Delphi since BDS 2006 SP2.
(0020231)
AHUser (developer)
2012-09-27 09:55

Sorry, but I had to delete your attached Controls.dcu/pas. Delphi's license prohibits that you redistribute those files.

- Issue History
Date Modified Username Field Change
2011-08-27 05:01 cdsaenz New Issue
2011-09-21 12:00 obones Note Added: 0018945
2011-09-21 12:00 obones Status new => feedback
2012-02-23 11:20 obones Note Added: 0019504
2012-05-16 11:40 Thor Note Added: 0019760
2012-05-16 14:42 Thor Issue Monitored: Thor
2012-06-11 17:38 obones Note Added: 0019873
2012-08-28 16:04 wandarlei Issue Monitored: wandarlei
2012-08-28 16:45 wandarlei File Added: Problem_Example.zip
2012-09-24 16:24 frank_jepsen Note Added: 0020210
2012-09-24 21:04 AHUser Note Added: 0020211
2012-09-25 00:48 frank_jepsen File Added: Delphi7Fix.zip
2012-09-25 00:54 frank_jepsen Note Added: 0020213
2012-09-25 08:38 frank_jepsen File Added: Delphi7FixOk.zip
2012-09-25 08:47 frank_jepsen Note Added: 0020215
2012-09-25 09:48 AHUser File Deleted: Delphi7Fix.zip
2012-09-27 09:54 AHUser File Deleted: Delphi7FixOk.zip
2012-09-27 09:55 AHUser Note Added: 0020231
2012-09-27 09:55 AHUser Status feedback => resolved
2012-09-27 09:55 AHUser Resolution open => fixed
2012-09-27 09:55 AHUser Assigned To => AHUser


Mantis 1.1.6[^]
Copyright © 2000 - 2008 Mantis Group
Powered by Mantis Bugtracker