View Issue Details

Jump to NotesJump to History
IDProjectCategoryView StatusDate SubmittedLast Update
0005644JEDI VCL00 JVCL Componentspublic2011-08-27 05:012012-09-27 09:55
ReportercdsaenzAssigned ToAHUser 
PrioritynormalSeveritymajorReproducibilityalways
Status resolvedResolutionfixed 
Product Version3.40 
Target VersionFixed in Version 
Summary0005644: TJvTabDefaultPainter painting empty text on tabs in Delphi 7
DescriptionTJvTabDefaultPainter 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.
TagsNo tags attached.

Activities

obones

2011-09-21 12:00

administrator   ~0018945

Please provide the zipped sources of a sample application showing this

obones

2012-02-23 11:20

administrator   ~0019504

We really need a demo application to test this

Thor

2012-05-16 11:40

reporter   ~0019760

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

obones

2012-06-11 17:38

administrator   ~0019873

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.

2012-08-28 16:45

 

Problem_Example.zip (5,407 bytes)

frank_jepsen

2012-09-24 16:24

reporter   ~0020210

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.

AHUser

2012-09-24 21:04

developer   ~0020211

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.

frank_jepsen

2012-09-25 00:54

reporter   ~0020213

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).

frank_jepsen

2012-09-25 08:47

reporter   ~0020215

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.

AHUser

2012-09-27 09:55

developer   ~0020231

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-06-11 17:38 obones Note Added: 0019873
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