From d7bddcdede216de14aee992e3dddd5a9e74c0734 Mon Sep 17 00:00:00 2001 From: dkolmck Date: Fri, 17 Mar 2017 05:02:39 +0000 Subject: [PATCH] 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 | 159 +++++++++++++++++++++++--------------- KOL.pas | 109 +++++++++++++++----------- 2 files changed, 159 insertions(+), 109 deletions(-) diff --git a/Addons/KOLEcmListEdit.pas b/Addons/KOLEcmListEdit.pas index eeed8e6..e2ed403 100644 --- a/Addons/KOLEcmListEdit.pas +++ b/Addons/KOLEcmListEdit.pas @@ -133,6 +133,9 @@ interface uses Windows, Messages, KOL; +const + INPLACE_ITEMS_SEP = ';'; + type PEditorOptions = ^TEditorOptions; TEditorOptions = packed record @@ -224,23 +227,21 @@ type |

} 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,51 +556,56 @@ begin {$IFDEF _LE_DEBUG_} AddLog(Self.fOwner, 'SetEditPos'); {$ENDIF} - with fOwner^ do begin - R := LVSubItemRect(LVCurItem, fCurIdx); - cw := LVColWidth[fCurIdx]; - R.Right := R.Left + cw; - if Assigned(fInPlaceEd) then begin - Header := Perform(LVM_GETHEADER, 0, 0); - GetWindowRect(Header, Re); - HeaderHeight := Re.Bottom - Re.Top; - 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; - Inc(R.Top, cw); - Dec(R.Bottom, cw); - end; - Inc(R.Left, fShift - Re.Left); - Dec(R.Right, fShift - Re.Left); + R := fOwner.LVSubItemRect(fOwner.LVCurItem, fCurIdx); + cw := fOwner.LVColWidth[fCurIdx]; + R.Right := R.Left + cw; + if Assigned(fInPlaceEd) then begin + Header := fOwner.Perform(LVM_GETHEADER, 0, 0); + GetWindowRect(Header, Re); + HeaderHeight := Re.Bottom - Re.Top; + 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; + Inc(R.Top, cw); + Dec(R.Bottom, cw); end; - pEO := fColOptions.Items[fCurIdx]; - with pEO.Indent do begin - Inc(R.Left, Left); - Dec(R.Right, Right); - Inc(R.Top, Top); - Dec(R.Bottom, Bottom); - // - if fEmbedEd then - Dec(R.Left, 2); - end; - end else - FillChar(R, SizeOf(R), 0); - fInPlaceEd.BoundsRect := R; - end; - if (R.Left <= 0) then - fScroll := R.Left - else if (R.Right > fOwner.Width - 24) then - fScroll := R.Right - (fOwner.Width - 24) - else - fScroll := 0; + Inc(R.Left, fShift - Re.Left); + Dec(R.Right, fShift - Re.Left); + end; + pEO := fColOptions.Items[fCurIdx]; + with pEO.Indent do begin + Inc(R.Left, Left); + Dec(R.Right, Right); + Inc(R.Top, Top); + Dec(R.Bottom, Bottom); + // + if fEmbedEd then + Dec(R.Left, 2); + 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 + fScroll := R.Left + else if (R.Right > fOwner.Width - 24) then + fScroll := R.Right - (fOwner.Width - 24) + else + fScroll := 0; 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); - if (z = -1) then + i := fInPlaceEd.IndexOf(S); + 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 - S := fInPlaceEd.Text; - if Assigned(fOnPutText) then - fOnPutText(fOwner, fCurIdx, fOwner.LVCurItem, S); - if (S <> fOwner.LVItems[fOwner.LVCurItem, fCurIdx]) then begin - fCellChanged := True; - fOwner.LVItems[fOwner.LVCurItem, fCurIdx] := S; + // get new value for listview + if (fInPlaceEd.SubClassName = 'obj_SysListView32') then begin + newValue := ''; + for I := 0 to Pred(fInPlaceEd.LVCount) do begin + if (fInPlaceEd.LVItemStateImgIdx[I] = 2) then begin + if (newValue <> '') then + newValue := newValue + INPLACE_ITEMS_SEP; + newValue := newValue + fInPlaceEd.LVItems[I, 0]; + end; end; - fInPlaceEd.Text := S; + 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; diff --git a/KOL.pas b/KOL.pas index 6d5d1a1..e09af67 100644 --- a/KOL.pas +++ b/KOL.pas @@ -1064,8 +1064,8 @@ const type PThread = ^TThread; - TThreadMethod = procedure of object; - TThreadMethodEx = procedure( Sender: PThread; Param: Pointer ) of object; + TThreadMethod = function: LRESULT 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,10 +14552,10 @@ 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 ) - : Boolean; +function WndProcCMExec( Sender: PControl; var Msg: TMsg; var Rslt: LRESULT ): Boolean; + {$IFDEF _D2006orHigher} - {$I MCKfakeClasses200x.inc} // Dufa + {$I MCKfakeClasses200x.inc} // Dufa {$ENDIF} implementation @@ -20896,21 +20896,40 @@ asm end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; {$ENDIF PAS_ONLY} -function StrCat( Dest, Source: PAnsiChar ): PAnsiChar; +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 - begin - if Str^ = #0 then break; - inc(Str); + Result := nil; + if (Str = nil) then Exit; + + while (Str^ <> #0) do begin + if (Str^ = Chr) then begin + Result := Str; + Break; end; - Result := Str; + 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 ) - : Boolean; +function WndProcCMExec(Sender: PControl; var Msg: TMsg; var Rslt: LRESULT): Boolean; var Thread: PThread; begin Result := FALSE; - if Msg.message = CM_EXECPROC then - begin - Thread := PThread( Msg.lParam ); - if Msg.wParam <> 0 then - Thread.FMethodEx( Thread, Pointer( Msg.wParam ) ) - else Thread.FMethod( ); - Rslt := 0; + if (Msg.message = CM_EXECPROC) then begin + Thread := PThread(Msg.lParam); + if (Msg.wParam <> 0) then + Rslt := Thread.FMethodEx(Thread, Pointer(Msg.wParam)) + else + Rslt := Thread.FMethod(); end; end; {$IFDEF PSEUDO_THREADS} -function timeBeginPeriod(uPeriod: UINT): UINT; stdcall; -external 'winmm.dll' name 'timeBeginPeriod'; -function timeEndPeriod(uPeriod: UINT): UINT; stdcall; -external 'winmm.dll' name 'timeEndPeriod'; +function timeBeginPeriod(uPeriod: UINT): UINT; stdcall; external 'winmm.dll' name 'timeBeginPeriod'; +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} - FMethod := Method; - if Applet <> nil then - SendMessage( Applet.fHandle, CM_EXECPROC, 0, LPARAM( @Self ) ); + if Assigned(Applet) then begin + FMethod := Method; + Result := 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' ); + 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} - FMethodEx := Method; - SendMessage( Applet.fHandle, CM_EXECPROC, WPARAM( Param ), LPARAM( @Self ) ); + if Assigned(Applet) then begin + FMethodEx := Method; + 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 - begin + if (I >= 0) then 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 := I >=0; + Result := (fDynHandlers.IndexOf(@Proc) >= 0); end; {$ENDIF PAS_VERSION} @@ -58025,8 +58043,7 @@ type end; PFindWndRec = ^TFindWndRec; -function EnumWindowsProc( Wnd : HWnd; Find : PFindWndRec ) : Boolean; -stdcall; +function EnumWindowsProc( Wnd : HWnd; Find : PFindWndRec ) : Boolean; stdcall; var Id : DWord; begin Result := True;