pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

KOLEcmListEdit.pas:

Browse Source 
* 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
This commit is contained in:
dkolmck
2017-03-17 05:02:39 +00:00
parent 8acb6d67e6
commit d7bddcdede
2 changed files with 159 additions and 109 deletions
Download Patch File Download Diff File Expand all files Collapse all files

159
Addons/KOLEcmListEdit.pas
View File

@@ -133,6 +133,9 @@ interface
uses
Windows, Messages, KOL;
const
INPLACE_ITEMS_SEP = ';';
type
PEditorOptions = ^TEditorOptions;
TEditorOptions = packed record
@@ -224,23 +227,21 @@ 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;
{*
|<p>
@@ -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;

109
KOL.pas
View File

@@ -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;