pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source
This commit is contained in:
dkolmck
2010-04-10 14:33:55 +00:00
parent fd477233b5
commit f5b39b5a0a
4 changed files with 59 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
KOL.pas
View File

@@ -557,7 +557,6 @@ uses {$IFDEF WIN}messages, windows {$IFNDEF NOT_USE_RICHEDIT}, RichEdit {$ENDIF}
////type HDC = TGC; // from Xlib (temporary definition?) ////type HDC = TGC; // from Xlib (temporary definition?)
{$ENDIF LIN} {$ENDIF LIN}
var var
AppTheming: Boolean; AppTheming: Boolean;
{$IFDEF DEBUG_GDIOBJECTS} {$IFDEF DEBUG_GDIOBJECTS}
@@ -1073,7 +1072,7 @@ type
//[END OF TThread DEFINITION] //[END OF TThread DEFINITION]
//[NewThread, NewThreadEx, NewThreadAutoFree DECLARATIONS] //[NewThread, NewThreadEx, NewThreadAutoFree DECLARATIONS]
function NewThread: PThread; function NewThread(const stackize: DWORD = 0): PThread;
{* Creates thread object (always suspended). After creating, set event {* Creates thread object (always suspended). After creating, set event
OnExecute and perform Resume operation. } OnExecute and perform Resume operation. }
@@ -1507,6 +1506,15 @@ RT_VERSION Version resource
type type
TCompareStrListFun = function( const S1, S2: PAnsiChar ): Integer; TCompareStrListFun = function( const S1, S2: PAnsiChar ): Integer;
//[Sorting TYPES]
TCompareEvent = function (const Data: Pointer; const e1,e2 : Dword) : Integer;
{* Event type to define comparison function between two elements of an array.
This event handler must return -1 or +1 (correspondently for cases e1<e2
and e2>e2). Items are enumerated from 0 to uNElem. }
TSwapEvent = procedure (const Data : Pointer; const e1,e2 : Dword);
{* Event type to define swap procedure which is swapping two elements of an
array. }
{++}(*TStrList = class;*){--} {++}(*TStrList = class;*){--}
PStrList = {-}^{+}TStrList; PStrList = {-}^{+}TStrList;
{ --------------------------------------------------------------------- { ---------------------------------------------------------------------
@@ -1614,6 +1622,8 @@ type
{* Call it to sort string list. } {* Call it to sort string list. }
procedure AnsiSort( CaseSensitive: Boolean ); procedure AnsiSort( CaseSensitive: Boolean );
{* Call it to sort ANSI string list. } {* Call it to sort ANSI string list. }
procedure SortEx(const CompareFun: TCompareEvent);
{* Call it to custom sort string list. Dufa }
// by Alexander Pravdin: // by Alexander Pravdin:
protected protected
@@ -11580,16 +11590,6 @@ function RegKeyGetValueTyp (const Key:HKEY; const ValueName: KOLString) : DWORD;
renamed to SortData - which is a regular procedure now). } renamed to SortData - which is a regular procedure now). }
{$ENDIF WIN_GDI} //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ {$ENDIF WIN_GDI} //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
//[Sorting TYPES]
type
TCompareEvent = function (const Data: Pointer; const e1,e2 : Dword) : Integer;
{* Event type to define comparison function between two elements of an array.
This event handler must return -1 or +1 (correspondently for cases e1<e2
and e2>e2). Items are enumerated from 0 to uNElem. }
TSwapEvent = procedure (const Data : Pointer; const e1,e2 : Dword);
{* Event type to define swap procedure which is swapping two elements of an
array. }
//[SortData FUNCTIONS DECLARATIONS] //[SortData FUNCTIONS DECLARATIONS]
procedure SortData( const Data: Pointer; const uNElem: Dword; procedure SortData( const Data: Pointer; const uNElem: Dword;
const CompareFun: TCompareEvent; const CompareFun: TCompareEvent;
@@ -24912,7 +24912,7 @@ end;
{$ELSE not_USE_CONSTRUCTORS} {$ELSE not_USE_CONSTRUCTORS}
//* //*
//[function NewThread] //[function NewThread]
function NewThread: PThread; function NewThread(const stackize: DWORD = 0): PThread;
begin begin
{$IFNDEF FPC105ORBELOW} {$IFNDEF FPC105ORBELOW}
IsMultiThread := True; IsMultiThread := True;
@@ -24924,8 +24924,8 @@ begin
Result.FSuspended := True; Result.FSuspended := True;
{$IFDEF PSEUDO_THREADS} {$IFDEF PSEUDO_THREADS}
{$ELSE} {$ELSE}
Result.FHandle := CreateThread( nil, // no security Result.FHandle := CreateThread( nil, // no security
0, // the same stack size stackize, // the same stack size
@ThreadFunc, // thread entry point @ThreadFunc, // thread entry point
Result, // parameter to pass to ThreadFunc Result, // parameter to pass to ThreadFunc
CREATE_SUSPENDED, // always SUSPENDED CREATE_SUSPENDED, // always SUSPENDED
@@ -41054,6 +41054,12 @@ begin
end; end;
{$ENDIF ASM_VERSION} {$ENDIF ASM_VERSION}
//[procedure TStrList.SortEx]
procedure TStrList.SortEx(const CompareFun: TCompareEvent);
begin
SortData(@Self, fCount, CompareFun, {@SwapStrListItems}@TStrList.Swap);
end;
//[procedure TStrList.Swap] //[procedure TStrList.Swap]
procedure TStrList.Swap(Idx1, Idx2: Integer); procedure TStrList.Swap(Idx1, Idx2: Integer);
begin begin

8
KOLMCK_D2010.dpk
View File

@@ -1,7 +1,7 @@
package KOLMCK_D2010; package KOLMCK_D2010;
{$R KOLMCK.res} {$R 'KOLMCK.res'}
{$ALIGN 8} {$ALIGN 4}
{$ASSERTIONS ON} {$ASSERTIONS ON}
{$BOOLEVAL OFF} {$BOOLEVAL OFF}
{$DEBUGINFO ON} {$DEBUGINFO ON}
@@ -21,8 +21,8 @@ package KOLMCK_D2010;
{$VARSTRINGCHECKS ON} {$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF} {$WRITEABLECONST OFF}
{$MINENUMSIZE 1} {$MINENUMSIZE 1}
{$IMAGEBASE $400000} {$IMAGEBASE $9400000}
{$DESCRIPTION '_KOL_ mirror controls for Delphi 2010'} {$DESCRIPTION 'KOLMCK 2010'}
{$DESIGNONLY} {$DESIGNONLY}
{$IMPLICITBUILD OFF} {$IMPLICITBUILD OFF}
{$DEFINE INPACKAGE} {$DEFINE INPACKAGE}

50
KOL_ASM.inc
View File

@@ -6374,31 +6374,35 @@ end;
// by Galkov, Jun-2009 // by Galkov, Jun-2009
function WndProcNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; function WndProcNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
asm asm
CMP word ptr [EDX].TMsg.message, WM_NOTIFY CMP word ptr [EDX].TMsg.message, WM_NOTIFY
JNE @@ret_false JNE @@ret_false
PUSH ECX PUSH ECX
PUSH EDX PUSH EDX
MOV ECX, [EDX].TMsg.lParam PUSH EAX
{$IFDEF USE_PROP} MOV ECX, [EDX].TMsg.lParam
PUSH offset[ID_SELF] {$IFDEF USE_PROP}
PUSH [ECX].TNMHdr.hwndFrom PUSH offset[ID_SELF]
CALL GetProp PUSH [ECX].TNMHdr.hwndFrom
{$ELSE} CALL GetProp
PUSH GWL_USERDATA {$ELSE}
PUSH [ECX].TNMHdr.hwndFrom PUSH GWL_USERDATA
CALL GetWindowLong PUSH [ECX].TNMHdr.hwndFrom
{$ENDIF} CALL GetWindowLong
POP EDX {$ENDIF}
TEST EAX, EAX POP ECX
JZ @@ret_false_ECX POP EDX
MOV ECX, [EAX].TControl.fHandle TEST EAX, EAX
MOV [EDX].TMsg.hwnd, ECX JZ @@ret_false_ECX
POP ECX CMP EAX, ECX
JMP TControl.EnumDynHandlers JZ @@ret_false_ECX
MOV ECX, [EAX].TControl.fHandle
MOV [EDX].TMsg.hwnd, ECX
POP ECX
JMP TControl.EnumDynHandlers
@@ret_false_ECX: @@ret_false_ECX:
POP ECX POP ECX
@@ret_false: @@ret_false:
XOR EAX, EAX XOR EAX, EAX
end; end;
function WndProcCommonNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; function WndProcCommonNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;

15
MCKAppExpert200x.pas
View File

@@ -217,14 +217,12 @@ begin
dlg.Options := [ofOverwritePrompt, ofExtensionDifferent, ofPathMustExist]; dlg.Options := [ofOverwritePrompt, ofExtensionDifferent, ofPathMustExist];
dlg.Title := 'Save Project'; dlg.Title := 'Save Project';
dlg.Filter := 'DPR files|*.dpr'; dlg.Filter := 'DPR files|*.dpr';
dlg.DefaultExt := 'dpr';
if dlg.Execute then begin if dlg.Execute then begin
prj := dlg.FileName; prj := dlg.FileName;
if (Pos('.', prj) = Length(prj) - 3) then if (Pos('.', prj) = Length(prj) - 3) then
SetLength(prj, Length(prj) - 4); SetLength(prj, Length(prj) - 4);
dlg.Title := 'Save Unit'; dlg.Title := 'Save Unit';
dlg.Filter := 'PAS files|*.pas'; dlg.Filter := 'PAS files|*.pas';
dlg.DefaultExt := 'pas';
dlg.FileName := 'unit1'; dlg.FileName := 'unit1';
if dlg.Execute then begin if dlg.Execute then begin
unt := dlg.FileName; unt := dlg.FileName;
@@ -234,18 +232,19 @@ begin
lst := TStringList.Create; lst := TStringList.Create;
lst.Text := StringReplace(prj_template, '%prj_name%', ExtractFileName(prj), [rfReplaceAll]); lst.Text := StringReplace(prj_template, '%prj_name%', ExtractFileName(prj), [rfReplaceAll]);
lst.Text := StringReplace(lst.Text, '%unt_name%', ExtractFileName(unt), [rfReplaceAll]); lst.Text := StringReplace(lst.Text, '%unt_name%', ExtractFileName(unt), [rfReplaceAll]);
lst.SaveToFile(prj + '.dpr'); lst.SaveToFile(ChangeFileExt(prj, '.dpr'));
// gen unit // gen unit
lst.Text := StringReplace(unt_template, '%unt_name%', ExtractFileName(unt), [rfReplaceAll]); lst.Text := StringReplace(unt_template, '%unt_name%', ExtractFileName(unt), [rfReplaceAll]);
lst.SaveToFile(unt + '.pas'); lst.SaveToFile(ChangeFileExt(unt, '.pas'));
// gen dfm // gen dfm
lst.Text := StringReplace(dfm_template, '%path%', ExtractFilePath(unt), [rfReplaceAll]); lst.Text := StringReplace(dfm_template, '%path%', ExtractFilePath(unt), [rfReplaceAll]);
lst.SaveToFile(unt + '.dfm'); lst.SaveToFile(ChangeFileExt(unt, '.dfm'));
// close all // close all
if (MessageBox(0, 'Close all projects before opening new?', 'MCKAppExpert200x', MB_ICONQUESTION or MB_YESNO) = IDYES) then //if (MessageBox(0, 'Close all projects before opening new?', 'MCKAppExpert200x', MB_ICONQUESTION or MB_YESNO) = IDYES) then
(BorlandIDEServices as IOTAModuleServices).CloseAll; // (BorlandIDEServices as IOTAModuleServices).CloseAll;
// open new // open new
(BorlandIDEServices as IOTAActionServices).OpenProject(prj + '.dpr', False); // (BorlandIDEServices as IOTAActionServices).OpenProject(ChangeFileExt(prj, '.dpr'), True);
(BorlandIDEServices as IOTAActionServices).OpenFile(ChangeFileExt(prj, '.dpr'));
// free // free
lst.Free; lst.Free;
end; end;