pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

20070401 release (0.1.3): Fixes TO32FlexEdit tabbing and validation problems on win32 widgetset.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@138 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
macpgmr
2007-04-01 19:59:51 +00:00
parent 479926d209
commit 77d87602b6
3 changed files with 85 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
components/orpheus/OrphStatus.html
View File

@ -33,6 +33,10 @@
<A name="Whats_New"></A><H3>What's New</H3>
<UL>
<LI>20070401 release (0.1.3):
<UL>
Improvements to TO32FlexEdit on Windows.<P>
</UL>
<LI>20070317 note:
<UL>
<LI>Recent improvements in the Lazarus Carbon widgetset add basic functionality
@ -161,7 +165,7 @@ access to the Lazarus install folder. After rebuilding, be sure to start
<TD>XP SP2</TD>
<TD>&nbsp;</TD>
<TD>win32</TD>
<TD>20070309 snapshot of 0.9.21 with FPC 2.1.1</TD>
<TD>20070330 snapshot of 0.9.23 with FPC 2.1.3</TD>
</TR>
<TR VALIGN=TOP>
@ -169,7 +173,7 @@ access to the Lazarus install folder. After rebuilding, be sure to start
<TD>10.4.9 (Tiger) on PowerPC</TD>
<TD>gtk: 1.2.0.9.1<BR>gtk2: 2.6.10<BR>qt: 4.2.2</TD>
<TD>gtk, gtk2, carbon, qt</TD>
<TD>20070316 snapshot of 0.9.21 with FPC 2.0.4</TD>
<TD>20070330 snapshot of 0.9.23 with FPC 2.0.4</TD>
</TR>
<TR VALIGN=TOP>
@ -581,10 +585,9 @@ However, TO32FlexEdit doesn't need TOvcController.<P>
<LI>Figure out why, on Windows, presence of XP manifest prevents setting Text.
<LI>Come up with workaround for LCL's lack of MakeObjectInstance for making
callback function from method. Without this, control's validation is not
performed. (See LclEditWindowProc in ovctccbx.pas for example
of a workaround approach that currently doesn't work.)
<LI>Can't tab out of control on Windows with win32 widgetset (tabbing works
with qt widgetset on Windows though).
performed. <==Workaround in 0.1.3 release fixes this on win32 widgetset.
<LI><strike>Can't tab out of control on Windows with win32 widgetset (tabbing works
with qt widgetset on Windows though).</strike> <==Fixed in 0.1.3 release.
</UL>
<LI>TOvcTable
<UL>
@ -629,7 +632,7 @@ OS X tips for Lazarus:<P>
<P>
<HR>
Last updated: March 17, 2007
Last updated: April 1, 2007
<P>
</BODY>

77
components/orpheus/o32vlop1.pas
View File

@ -122,6 +122,45 @@ type
implementation
// Note that workaround below currently works only with win32.
// Other widgetsets currently don't implement Get/SetWindowLong
// or never call LclWndProc (don't implement CallWindowProc
// correctly?), but the workaround code appears harmless.
// Just undefine LCLWndProc to disable workaround code.
{$IFDEF LCL}
{$DEFINE LCLWndProc}
{$ENDIF}
{$IFDEF LCLWndProc}
// Workaround for lack of MakeObjectInstance in LCL for making
// a WindowProc callback function from an object method.
// Pass pointer to this function to SetWindowLong wherever using
// MakeObjectInstance. Also set window's user data to pointer to
// object method's pointers so method can be reconstituted here.
// Note: Adapted from Felipe's CallbackAllocateHWnd procedure.
function LclWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM) : LRESULT;
{$IFDEF MSWINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
var
AMsg : TMessage;
MethodPtr : ^TWndMethod;
begin
FillChar(AMsg, SizeOf(Msg), #0);
{Populate message}
AMsg.Msg := Msg;
AMsg.WParam := wParam;
AMsg.LParam := lParam;
{Get pointer to memory containing method's code and data pointers}
MethodPtr := Pointer(GetWindowLong(hWnd, GWL_USERDATA));
if Assigned(MethodPtr) then
MethodPtr^(AMsg); {Dereference pointer and call method with message}
end;
{$ENDIF}
{===== TValidatorOptions =============================================}
constructor TValidatorOptions.Create(AOwner: TWinControl);
begin
@ -136,6 +175,10 @@ begin
{$ELSE}
NewWndProc := MakeObjectInstance(voWndProc);
{$ENDIF}
{$ELSE}
{$IFDEF LCLWndProc}
NewWndProc := @LclWndProc;
{$ENDIF}
{$ENDIF}
ValidatorType := 'None';
@ -163,6 +206,9 @@ end;
procedure TValidatorOptions.HookControl;
var
P : Pointer;
{$IFDEF LCLWndProc}
MethodPtr : ^TWndMethod;
{$ENDIF}
begin
if not FEnableHooking then exit;
{hook into owner's window procedure}
@ -173,6 +219,14 @@ begin
if (P <> NewWndProc) then begin
PrevWndProc := P;
{redirect message handling to ours}
{$IFDEF LCLWndProc}
GetMem(MethodPtr, SizeOf(TMethod)); {Allocate memory}
MethodPtr^ := voWndProc; {Store method's code and data pointers}
{Associate pointer to memory with window}
SetWindowLong(FHookedControl.Handle, GWL_USERDATA, PtrInt(MethodPtr));
if not Assigned(Pointer(GetWindowLong(FHookedControl.Handle, GWL_USERDATA))) then
FreeMem(MethodPtr); //SetWindowLong not implemented for widgetset
{$ENDIF}
SetWindowLong(FHookedControl.Handle, GWL_WNDPROC, LongInt(NewWndProc));
end;
end;
@ -180,10 +234,22 @@ end;
{=====}
procedure TValidatorOptions.UnHookControl;
{$IFDEF LCLWndProc}
var
MethodPtr : ^TWndMethod;
{$ENDIF}
begin
if (FHookedControl <> nil) then begin
if Assigned(PrevWndProc) and FHookedControl.HandleAllocated then
begin
{$IFDEF LCLWndProc}
{Get pointer to memory allocated previously}
MethodPtr := Pointer(GetWindowLong(FHookedControl.Handle, GWL_USERDATA));
if Assigned(MethodPtr) then
FreeMem(MethodPtr);
{$ENDIF}
SetWindowLong(FHookedControl.Handle, GWL_WNDPROC, LongInt(PrevWndProc));
end;
end;
PrevWndProc := nil;
end;
@ -251,15 +317,20 @@ procedure TValidatorOptions.voWndProc(var Msg : TMessage);
begin
with Msg do begin
case FEvent of
veOnEnter : if Msg = CM_ENTER then
veOnEnter : if Msg = {$IFNDEF LCL} CM_ENTER {$ELSE} LM_SETFOCUS {$ENDIF} then
Validate;
veOnExit : if Msg = CM_EXIT then
veOnExit : if Msg = {$IFNDEF LCL} CM_EXIT {$ELSE} LM_KILLFOCUS {$ENDIF} then
if (not Validate) and (not FSoftValidation) then
begin
FHookedControl.SetFocus;
{$IFDEF LCL}
Exit;
{$ENDIF}
end;
{TextChanged}
veOnChange : if Msg = 48435 then
veOnChange : if Msg = 48435 then //Probably doesn't work with LCL
Validate;
end;

2
components/orpheus/orpheus.lpk
View File

@ -31,7 +31,7 @@
"/>
<License Value="MPL 1.1
"/>
<Version Minor="1" Release="2"/>
<Version Minor="1" Release="3"/>
<Files Count="1">
<Item1>
<Filename Value="myovcreg.pas"/>