KOLEcmListEdit.pas:

* code formatting
* some fixes

KOL.pas:

* code formatting
* fix crash in StrScan (by Netspirit)
* fix crash in StrCat (see StrScan)
* TThread.FOnSuspend: TThreadMethod -> TThread.TObjectMethod
* TThreadMethod procedure -> function (for get result from TThread.Synchronize and TThread.SynchronizeEx)

git-svn-id: https://svn.code.sf.net/p/kolmck/code@157 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07

Addons/KOLEcmListEdit.pas

@@ -133,6 +133,9 @@ interface
 uses
   Windows, Messages, KOL;
 
+const
+  INPLACE_ITEMS_SEP = ';';
+
 type
   PEditorOptions = ^TEditorOptions;
   TEditorOptions = packed record
@@ -224,22 +227,20 @@ type
 |</p>
     }
     procedure SelectCell(ACol, ARow: Integer);
-    {* ������������ ������� ������   }
+    //* ������������ ������� ������   }
     procedure UpdateRow(ARow: Integer);
-    {* ����������� (Invalidate) ��������� ������    }
+    //* ����������� (Invalidate) ��������� ������    }
     property Editing: Boolean read fStarted;
-    {* True - ���������� �������� �������. }
+    //* True - ���������� �������� �������. }
     property OnGetEditText: TOnEditText read fOnGetText write fOnGetText;
-    {* ���������� ��� �������� ������ �� ���������� ��������. (��������
+    //* ���������� ��� �������� ������ �� ���������� ��������. (�������� ��� ������ �������).
-    ��� ������ �������). }
     property OnPutEditText: TOnEditText read fOnPutText write fOnPutText;
-    {* ���������� ��� �������� ������ �� ����������� ���������. (��������
+    //* ���������� ��� �������� ������ �� ����������� ���������. (�������� ��� ������ �������).
-    ��� ������ �������). }
     property OnStopEdit: TOnEndEdit read fOnEndEdit write fOnEndEdit;
-    {* ���������� ��� ����� ������ �������������� � ��� ���������� StopEdit. }
+    //* ���������� ��� ����� ������ �������������� � ��� ���������� StopEdit. }
     property OnEditChar: TOnEditChar read fOnEditChar write fOnEditChar;
-    {* ���������� ��� ��������� ���������� ���������� ������� WM_CHAR. �����
+    //* ���������� ��� ��������� ���������� ���������� ������� WM_CHAR. �����
-    �������������� ��� ��������� �����}
+    // ������������ ��� ��������� �����
     //---------------------------------------------------------------------------
     property OnColAdjust: TOnColAdjust read FOnColAdjust write fOnColAdjust;
     {*
@@ -555,15 +556,14 @@ begin
 {$IFDEF _LE_DEBUG_}
   AddLog(Self.fOwner, 'SetEditPos');
 {$ENDIF}
-  with fOwner^ do begin
+  R  := fOwner.LVSubItemRect(fOwner.LVCurItem, fCurIdx);
-    R := LVSubItemRect(LVCurItem, fCurIdx);
+  cw := fOwner.LVColWidth[fCurIdx];
-    cw := LVColWidth[fCurIdx];
   R.Right := R.Left + cw;
   if Assigned(fInPlaceEd) then begin
-      Header := Perform(LVM_GETHEADER, 0, 0);
+    Header := fOwner.Perform(LVM_GETHEADER, 0, 0);
     GetWindowRect(Header, Re);
     HeaderHeight := Re.Bottom - Re.Top;
-      if R.Top >= HeaderHeight then begin
+    if (R.Top >= HeaderHeight) then begin
       if fEmbedEd and (fInPlaceEd.Perform(EM_GETRECT, 0, Integer(@Re)) > 0) then begin
         if (R.Bottom - R.Top) > (Re.Bottom - Re.Top) then begin
           cw := ((R.Bottom - R.Top) - (Re.Bottom - Re.Top)) div 2;
@@ -585,6 +585,12 @@ begin
       end;
     end else
       FillChar(R, SizeOf(R), 0);
+
+    // for listview
+    if (fInPlaceEd.SubClassName = 'obj_SysListView32') then
+      R.Bottom := R.Bottom + (R.Bottom - R.Top) * 4;
+
+    // set rect
     fInPlaceEd.BoundsRect := R;
   end;
   if (R.Left <= 0) then
@@ -594,12 +600,12 @@ begin
   else
     fScroll := 0;
 end;
-end;
 
 procedure TEcmListEdit.LoadEditValues;
 var
-  z: Integer;
+  i: Integer;
   S: String;
+  V: String;
 begin
 {$IFDEF _LE_DEBUG_}
   AddLog(Self.fOwner, 'LoadEditValues');
@@ -609,16 +615,27 @@ begin
     fOnGetText(fOwner, fCurIdx, fOwner.LVCurItem, S);
 
   if IsComboEditor then begin
-    IsComboEditor       := False; //
+    IsComboEditor       := False; 
     fInPlaceEd.CurIndex := fInPlaceEd.IndexOf(S);
     //fInPlaceEd.DroppedDown := True;
   end else begin //if fEmbedEd then begin
     if (fInPlaceEd.SubClassName = 'obj_COMBOBOX') then begin
-      z := fInPlaceEd.IndexOf(S);
+      i := fInPlaceEd.IndexOf(S);
-      if (z = -1) then
+      if (i = -1) then
         fInPlaceEd.Text := S
       else
-        fInPlaceEd.CurIndex := z;
+        fInPlaceEd.CurIndex := i;
+    end else if (fInPlaceEd.SubClassName = 'obj_SysListView32') then begin
+      fInPlaceEd.LVItemStateImgIdx[-1] := 1;
+      repeat
+        V := Parse(S, INPLACE_ITEMS_SEP);
+        if (V = '') and (S = '') then
+          Break;
+        // set flag
+        i := fInPlaceEd.LVIndexOf(V);
+        if (i > -1) then
+          fInPlaceEd.LVItemStateImgIdx[i] := 2;
+      until False;
     end else begin // 'obj_EDIT'
       fInPlaceEd.Text := S;
       fInPlaceEd.SelectAll;
@@ -644,7 +661,7 @@ begin
         Result           := NewCombobox(fOwner, ComboOptions);
         Result.OnCloseUp := ComboBox_CloseUp;
         repeat
-          Result.Add(Parse(ComboText, ';'));
+          Result.Add(Parse(ComboText, INPLACE_ITEMS_SEP));
         until (ComboText = '');
       end else
         Result := NewEditBox(fOwner, Options);
@@ -886,7 +903,8 @@ end;
 
 procedure TEcmListEdit.InternalStopEdit(const Store: Boolean);
 var
-  s: String;
+  i:            Integer;
+  newValue:     String;
   fCellChanged: Boolean;
 begin
   if fStarted then begin
@@ -895,15 +913,30 @@ begin
 {$ENDIF}
     fCellChanged := False;
     if Store then begin
-      if (fOwner.LVItems[fOwner.LVCurItem, fCurIdx] <> fInPlaceEd.Text) then begin
+      // get new value for listview
-        S := fInPlaceEd.Text;
+      if (fInPlaceEd.SubClassName = 'obj_SysListView32') then begin
-        if Assigned(fOnPutText) then
+        newValue := '';
-          fOnPutText(fOwner, fCurIdx, fOwner.LVCurItem, S);
+        for I := 0 to Pred(fInPlaceEd.LVCount) do begin
-        if (S <> fOwner.LVItems[fOwner.LVCurItem, fCurIdx]) then begin
+          if (fInPlaceEd.LVItemStateImgIdx[I] = 2) then begin
-          fCellChanged := True;
+            if (newValue <> '') then
-          fOwner.LVItems[fOwner.LVCurItem, fCurIdx] := S;
+              newValue := newValue + INPLACE_ITEMS_SEP;
+            newValue := newValue + fInPlaceEd.LVItems[I, 0];
           end;
-        fInPlaceEd.Text := S;
+        end;
+      end else // get new value other
+        newValue := fInPlaceEd.Text;
+
+      // compare new with old
+      if (fOwner.LVItems[fOwner.LVCurItem, fCurIdx] <> newValue) then begin
+        if Assigned(fOnPutText) then
+          fOnPutText(fOwner, fCurIdx, fOwner.LVCurItem, newValue);
+
+        if (fOwner.LVItems[fOwner.LVCurItem, fCurIdx] <> newValue) then begin
+          fCellChanged := True;
+          fOwner.LVItems[fOwner.LVCurItem, fCurIdx] := newValue;
+        end;
+
+        fInPlaceEd.Text := newValue;
       end;
     end;
     fStarted := False;

KOL.pas

@@ -1064,8 +1064,8 @@ const
 type
   PThread = ^TThread;
 
-  TThreadMethod = procedure of object;
+  TThreadMethod   = function: LRESULT of object;
-  TThreadMethodEx = procedure( Sender: PThread; Param: Pointer ) of object;
+  TThreadMethodEx = function(Sender: PThread; Param: Pointer): LRESULT of object;
 
   TOnThreadExecute = function(Sender: PThread): PtrInt of object;
   {* Event to be called when Execute method is called for TThread }
@@ -1092,7 +1092,7 @@ type
     FTerminated: Boolean;
     FHandle: THandle;
     FThreadId: DWORD;
-    FOnSuspend: TObjectMethod;
+    FOnSuspend: TThreadMethod;//TObjectMethod;
     FOnResume: TOnEvent;
     FData : Pointer;
     FOnExecute : TOnThreadExecute;
@@ -1164,14 +1164,14 @@ type
 
     property OnExecute: TOnThreadExecute read FOnExecute write FOnExecute;
     {* Is called, when Execute is starting. }
-    property OnSuspend: TObjectMethod read FOnSuspend write FOnSuspend;
+    property OnSuspend: TThreadMethod{TObjectMethod} read FOnSuspend write FOnSuspend;
     {* Is called, when Suspend is performed. }
     property OnResume: TOnEvent read FOnResume write FOnResume;
     {* Is called, when resumed. }
-    procedure Synchronize( Method: TThreadMethod );
+    function Synchronize( Method: TThreadMethod ): LRESULT;
     {* Call it to execute given method in main thread context. Applet variable
        must exist for that time. }
-    procedure SynchronizeEx( Method: TThreadMethodEx; Param: Pointer );
+    function SynchronizeEx( Method: TThreadMethodEx; Param: Pointer ): LRESULT;
     {* Call it to execute given method in main thread context, with a given
        parameter. Applet variable must exist for that time. Param must not be nil. }
     {$IFDEF USE_CONSTRUCTORS}
@@ -14552,8 +14552,8 @@ procedure _SetDIBPixelsTrueColorAlpha( Bmp: PBitmap; X, Y: Integer; Value: TColo
 var OnMonitorMessage: procedure( var M: TMsg; Enter_WndFunc: Boolean ) of object = nil;
 {$ENDIF}
 
-function WndProcCMExec( Sender: PControl; var Msg: TMsg; var Rslt: LRESULT )
+function WndProcCMExec( Sender: PControl; var Msg: TMsg; var Rslt: LRESULT ): Boolean;
-                          : Boolean;
+
 {$IFDEF _D2006orHigher}
   {$I MCKfakeClasses200x.inc} // Dufa
 {$ENDIF}
@@ -20897,20 +20897,39 @@ end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};
 {$ENDIF PAS_ONLY}
 
 function StrCat(Dest, Source: PAnsiChar): PAnsiChar;
+var
+  str: PAnsiChar;
 begin
-  StrCopy( StrScan( Dest, #0 ), Source );
+  // by dufa
+  str := StrScan(Dest, #0);
+  if Assigned(str) then  
+    StrCopy(str, Source);
   Result := Dest;
 end;
 
 {$IFDEF PAS_ONLY}
+//function bugStrScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar;
+//begin
+//    while Str^ <> Chr do
+//    begin
+//        if Str^ = #0 then break;
+//        inc(Str);
+//    end;
+//    Result := Str;
+//end;
+/// by Netspirit
 function StrScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar;
 begin
-    while Str^ <> Chr do
+  Result := nil;
-    begin
+  if (Str = nil) then Exit;
-        if Str^ = #0 then break;
+ 
-        inc(Str);
+  while (Str^ <> #0) do begin
-    end;
+    if (Str^ = Chr) then begin
       Result := Str;
+      Break;
+    end;
+    Inc(Str);
+  end;
 end;
 {$ELSE}
 function StrScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; assembler;
@@ -26501,26 +26520,22 @@ end;
 
 { TThread }
 
-function WndProcCMExec( Sender: PControl; var Msg: TMsg; var Rslt: LRESULT )
+function WndProcCMExec(Sender: PControl; var Msg: TMsg; var Rslt: LRESULT): Boolean;
-                          : Boolean;
 var Thread: PThread;
 begin
   Result := FALSE;
-  if Msg.message = CM_EXECPROC then
+  if (Msg.message = CM_EXECPROC) then begin
-  begin
     Thread := PThread(Msg.lParam);
-    if   Msg.wParam <> 0 then
+    if (Msg.wParam <> 0) then
-         Thread.FMethodEx( Thread, Pointer( Msg.wParam ) )
+      Rslt := Thread.FMethodEx(Thread, Pointer(Msg.wParam))
-    else Thread.FMethod( );
+    else
-    Rslt := 0;
+      Rslt := Thread.FMethod();
   end;
 end;
 
 {$IFDEF PSEUDO_THREADS}
-function timeBeginPeriod(uPeriod: UINT): UINT; stdcall;
+function timeBeginPeriod(uPeriod: UINT): UINT; stdcall; external 'winmm.dll' name 'timeBeginPeriod';
-external 'winmm.dll' name 'timeBeginPeriod';
+function timeEndPeriod(uPeriod: UINT): UINT; stdcall; external 'winmm.dll' name 'timeEndPeriod';
-function timeEndPeriod(uPeriod: UINT): UINT; stdcall;
-external 'winmm.dll' name 'timeEndPeriod';
 {$ENDIF}
 
 procedure TThread.Init;
@@ -26840,27 +26855,33 @@ begin
 end;
 {$ENDIF PSEUDO_THREADS}
 
-procedure TThread.Synchronize(Method: TThreadMethod);
+function TThread.Synchronize(Method: TThreadMethod): LRESULT;
 begin
   {$IFDEF PSEUDO_THREADS}
-  Method;
+    Result := Method;
   {$ELSE}
+    if Assigned(Applet) then begin
       FMethod := Method;
-  if Applet <> nil then
+      Result  := SendMessage(Applet.fHandle, CM_EXECPROC, 0, LPARAM(@Self));
-    SendMessage( Applet.fHandle, CM_EXECPROC, 0, LPARAM( @Self ) );
+    end else
+      Result := -1;
   {$ENDIF}
 end;
 
-procedure TThread.SynchronizeEx( Method: TThreadMethodEx; Param: Pointer );
+function TThread.SynchronizeEx(Method: TThreadMethodEx; Param: Pointer): LRESULT;
 begin
   {$IFDEF KOL_ASSERTIONS}
     Assert( Param <> nil, 'Parameter must not be NIL' );
   {$ENDIF KOL_ASSERTIONS}
+
   {$IFDEF PSEUDO_THREADS}
-  Method( TMethod( Method ).Data, Param );
+    Result := Method( TMethod( Method ).Data, Param );
   {$ELSE}
+    if Assigned(Applet) then begin
       FMethodEx := Method;
-  SendMessage( Applet.fHandle, CM_EXECPROC, WPARAM( Param ), LPARAM( @Self ) );
+      Result    := SendMessage(Applet.fHandle, CM_EXECPROC, WPARAM(Param), LPARAM(@Self));
+    end else
+      Result := -1;
   {$ENDIF}
 end;
 
@@ -55623,8 +55644,7 @@ var I: Integer;
 begin
   if fDynHandlers = nil then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
   I := fDynHandlers.IndexOf( @Proc );
-  if I >=0 then
+  if (I >= 0) then begin
-  begin
     fDynHandlers.Delete( I );
     fDynHandlers.Delete( I );
   end;
@@ -55632,10 +55652,8 @@ end;
 
 {$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} //Pascal
 function TControl.IsProcAttached(Proc: TWindowFunc): Boolean;
-var I: Integer;
 begin
-  I := fDynHandlers.IndexOf( @Proc );
+  Result := (fDynHandlers.IndexOf(@Proc) >= 0);
-  Result := I >=0;
 end;
 {$ENDIF PAS_VERSION}
 
@@ -58025,8 +58043,7 @@ type
   end;
   PFindWndRec = ^TFindWndRec;
 
-function EnumWindowsProc( Wnd : HWnd; Find : PFindWndRec ) : Boolean;
+function EnumWindowsProc( Wnd : HWnd; Find : PFindWndRec ) : Boolean; stdcall;
-stdcall;
 var Id : DWord;
 begin
   Result := True;