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

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@138 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/orpheus/OrphStatus.html

@@ -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
+  performed. <==Workaround in 0.1.3 release fixes this on win32 widgetset. 
-  of a workaround approach that currently doesn't work.) 
+  <LI><strike>Can't tab out of control on Windows with win32 widgetset (tabbing works
-  <LI>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.
-  with qt widgetset on Windows though).
   </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>

components/orpheus/o32vlop1.pas

@@ -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,11 +234,23 @@ 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;

components/orpheus/orpheus.lpk

@@ -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"/>