pascal/kolmck
pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

3.03

Browse Source 
git-svn-id: https://svn.code.sf.net/p/kolmck/code@96 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck 2010-12-18 13:30:16 +00:00
parent 25b148d10b
commit ed2c4a3dcf
7 changed files with 119 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
Addons/tinyJPGGIFBMP.pas
View File

@ -11,9 +11,12 @@ unit tinyJPGGIFBMP;
interface interface
uses Windows, Kol, ActiveX; uses
Windows, KOL, ActiveX;
type TBitmapmod = object( TBitMap )end; type
TBitmapmod = object( TBitMap )
end;
procedure tinyLoadJPGGIFBMPFile(var TargetBitmap: PBitMap; FileName: String); procedure tinyLoadJPGGIFBMPFile(var TargetBitmap: PBitMap; FileName: String);
procedure tinyLoadJPGGIFBMPMemory(var TargetBitmap: PBitMap; Ptr: HGlobal; Size: DWORD); procedure tinyLoadJPGGIFBMPMemory(var TargetBitmap: PBitMap; Ptr: HGlobal; Size: DWORD);
@ -21,9 +24,10 @@ procedure tinyLoadJPGGIFBMPResource(var TargetBitmap: PBitMap; Inst : HInst; Res
implementation implementation
const IID_IPicture:TGUID='{7BF80980-BF32-101A-8BBB-00AA00300CAB}'; const
IID_IPicture:TGUID='{7BF80980-BF32-101A-8BBB-00AA00300CAB}';
function SHCreateStreamOnFileA(FileName: PChar; grfMode: DWORD;var stream: IStream):HResult; function SHCreateStreamOnFileA(FileName: PChar; grfMode: DWORD;var stream: IStream): HResult;
external 'shlwapi.dll' name 'SHCreateStreamOnFileA'; external 'shlwapi.dll' name 'SHCreateStreamOnFileA';
procedure OleFree( Picta: IPicture ); procedure OleFree( Picta: IPicture );

122
KOL.pas
View File

@ -14,7 +14,7 @@
Key Objects Library (C) 2000 by Kladov Vladimir. Key Objects Library (C) 2000 by Kladov Vladimir.
**************************************************************** ****************************************************************
* VERSION 3.01 * VERSION 3.03
**************************************************************** ****************************************************************
K.O.L. - is a set of objects to create small programs K.O.L. - is a set of objects to create small programs
@ -2165,7 +2165,7 @@ type
fParentGDITool: PGraphicTool; fParentGDITool: PGraphicTool;
{$ENDIF GDI} {$ENDIF GDI}
fColorRGB: TColor; fColorRGB: TColor;
fOnChange: TOnGraphicChange; fOnGTChange: TOnGraphicChange;
fData: TGDIToolData; fData: TGDIToolData;
fNewProc: TNewGraphicTool; fNewProc: TNewGraphicTool;
{$IFDEF GDI} {$IFDEF GDI}
@ -2239,7 +2239,7 @@ type
{* Returns True, if handle is allocated (i.e., if real GDI {* Returns True, if handle is allocated (i.e., if real GDI
objet is created. } objet is created. }
{$ENDIF GDI} {$ENDIF GDI}
property OnChange: TOnGraphicChange read fOnChange write fOnChange; property OnChange: TOnGraphicChange read fOnGTChange write fOnGTChange;
{* Called, when object is changed. } {* Called, when object is changed. }
{$IFDEF GDI} {$IFDEF GDI}
function ReleaseHandle: Integer; function ReleaseHandle: Integer;
@ -5216,7 +5216,9 @@ type
function REGetLangOptions(const Index: Integer): Boolean; function REGetLangOptions(const Index: Integer): Boolean;
procedure RESetLangOptions(const Index: Integer; const Value: Boolean); procedure RESetLangOptions(const Index: Integer; const Value: Boolean);
{$ENDIF NOT_USE_RICHEDIT} {$ENDIF NOT_USE_RICHEDIT}
public
procedure SetOnResize(const Value: TOnEvent); procedure SetOnResize(const Value: TOnEvent);
protected
procedure DoSelChange; procedure DoSelChange;
function LVGetItemImgIdx(Idx: Integer): Integer; function LVGetItemImgIdx(Idx: Integer): Integer;
procedure LVSetItemImgIdx(Idx: Integer; const Value: Integer); procedure LVSetItemImgIdx(Idx: Integer; const Value: Integer);
@ -5280,10 +5282,12 @@ type
function GetLVCurItem: Integer; function GetLVCurItem: Integer;
procedure SetLVCurItem(const Value: Integer); procedure SetLVCurItem(const Value: Integer);
function GetLVFocusItem: Integer; function GetLVFocusItem: Integer;
public
procedure SetOnDropFiles(const Value: TOnDropFiles); procedure SetOnDropFiles(const Value: TOnDropFiles);
procedure SetOnHide(const Value: TOnEvent); procedure SetOnHide(const Value: TOnEvent);
procedure SetOnShow(const Value: TOnEvent); procedure SetOnShow(const Value: TOnEvent);
procedure SetClientMargin(const Index: Integer; Value: ShortInt); procedure SetClientMargin(const Index: Integer; Value: ShortInt);
protected
{$IFDEF F_P} {$IFDEF F_P}
function GetClientMargin(const Index: Integer): Integer; function GetClientMargin(const Index: Integer): Integer;
{$ENDIF F_P} {$ENDIF F_P}
@ -5294,6 +5298,7 @@ type
{} fExposeEvent: Integer; {} fExposeEvent: Integer;
{$ENDIF GTK} {$ENDIF GTK}
{$ENDIF _X_} {$ENDIF _X_}
public
procedure SetOnPaint(const Value: TOnPaint); procedure SetOnPaint(const Value: TOnPaint);
{$IFDEF GDI} {$IFDEF GDI}
procedure SetOnEraseBkgnd(const Value: TOnPaint); procedure SetOnEraseBkgnd(const Value: TOnPaint);
@ -6266,7 +6271,16 @@ type
|<#richedit> |<#richedit>
Replaces selection (in edit, RichEdit). Unlike assigning new value Replaces selection (in edit, RichEdit). Unlike assigning new value
to Selection property, it is possible to specify, if operation can to Selection property, it is possible to specify, if operation can
be undone. } be undone.
|<br>
Use this method or assigning value to a Selection property to format
text initially in the rich edit. E.g.:
! RichEdit1.RE_FmtBold := TRUE;
! RichEdit1.Selection := 'bolded text'#13#10;
! RichEdit1.RE_FmtBold := FALSE;
! RichEdit1.RE_FmtItalic := TRUE;
! RichEdit1.Selection := 'italized text';
!... }
procedure DeleteLines( FromLine, ToLine: Integer ); procedure DeleteLines( FromLine, ToLine: Integer );
{* |<#edit> {* |<#edit>
@ -6914,7 +6928,7 @@ type
{* Name of window class - unique for every window class {* Name of window class - unique for every window class
in every run session of a program. } in every run session of a program. }
protected public
procedure SetOnClose( const AOnClose: TOnEventAccept ); procedure SetOnClose( const AOnClose: TOnEventAccept );
procedure SetFormOnClick( const AOnClick: TOnEvent ); procedure SetFormOnClick( const AOnClick: TOnEvent );
public public
@ -9521,6 +9535,7 @@ procedure FormSetWidth( Form: PControl );
procedure FormSetPosition( Form: PControl ); procedure FormSetPosition( Form: PControl );
procedure FormSetClientSize( Form: PControl ); procedure FormSetClientSize( Form: PControl );
procedure FormSetAlign( Form: PControl ); procedure FormSetAlign( Form: PControl );
procedure FormSetTag( Form: PControl );
{$IFDEF USE_NAMES} {$IFDEF USE_NAMES}
procedure FormSetName( Form: PControl ); procedure FormSetName( Form: PControl );
{$ENDIF USE_NAMES} {$ENDIF USE_NAMES}
@ -17417,6 +17432,7 @@ var n: Integer;
M: TMsg; M: TMsg;
{$ENDIF} {$ENDIF}
begin begin
if AppletWnd = nil then Exit;
AppletRunning := True; AppletRunning := True;
Applet := AppletWnd; Applet := AppletWnd;
AppletWnd.CreateWindow; //virtual!!! AppletWnd.CreateWindow; //virtual!!!
@ -17774,8 +17790,8 @@ begin
fHandle := 0; fHandle := 0;
end; end;
//////////////////////////////// ////////////////////////////////
if Assigned( fOnChange ) then if Assigned( TMethod( fOnGTChange ).Data ) then
fOnChange( @Self ); fOnGTChange( @Self );
//////////////////////////////// ////////////////////////////////
if H <> 0 then if H <> 0 then
begin begin
@ -19407,11 +19423,11 @@ END;
procedure TCanvas.AssignChangeEvents; procedure TCanvas.AssignChangeEvents;
begin begin
if ( fBrush <> nil ) then if ( fBrush <> nil ) then
fBrush.fOnChange := ObjectChanged; fBrush.fOnGTChange := ObjectChanged;
if ( fPen <> nil ) then if ( fPen <> nil ) then
fPen.fOnChange := ObjectChanged; fPen.fOnGTChange := ObjectChanged;
if ( fFont <> nil ) then if ( fFont <> nil ) then
fFont.fOnChange := ObjectChanged; fFont.fOnGTChange := ObjectChanged;
end; end;
{$ENDIF ASM_VERSION} {$ENDIF ASM_VERSION}
{$IFDEF WIN_GDI} {$IFDEF WIN_GDI}
@ -30833,13 +30849,6 @@ asm
MOV CL, Sz_TCommandActions MOV CL, Sz_TCommandActions
REP MOVSB REP MOVSB
POP ESI POP ESI
{
LEA EDX, [EBX].TControl.fCommandActions
XCHG EAX, EDI
XOR ECX, ECX
MOV CL, Sz_TCommandActions
CALL Move
}
JMP @@actions_created JMP @@actions_created
@@no_actions2: @@no_actions2:
MOV [EBX].TControl.fCommandActions.TCommandActions.aClear, offset[ClearText] MOV [EBX].TControl.fCommandActions.TCommandActions.aClear, offset[ClearText]
@ -30849,6 +30858,9 @@ asm
TEST ESI, ESI TEST ESI, ESI
JZ @@no_parent JZ @@no_parent
MOV EAX, [ESI].TControl.PP.fGotoControl
MOV [EBX].TControl.PP.fGotoControl, EAX
LEA ESI, [ESI].TControl.fTextColor LEA ESI, [ESI].TControl.fTextColor
LEA EDI, [EBX].TControl.fTextColor LEA EDI, [EBX].TControl.fTextColor
MOVSD // fTextColor MOVSD // fTextColor
@ -30877,8 +30889,8 @@ asm
XCHG ECX, EAX XCHG ECX, EAX
JECXZ @@no_font JECXZ @@no_font
MOV [ECX].TGraphicTool.fParentGDITool, EDX MOV [ECX].TGraphicTool.fParentGDITool, EDX
MOV [ECX].TGraphicTool.fOnChange.TMethod.Code, offset[TControl.FontChanged] MOV [ECX].TGraphicTool.fOnGTChange.TMethod.Code, offset[TControl.FontChanged]
MOV [ECX].TGraphicTool.fOnChange.TMethod.Data, EBX MOV [ECX].TGraphicTool.fOnGTChange.TMethod.Data, EBX
MOV EAX, EBX MOV EAX, EBX
MOV EDX, ECX MOV EDX, ECX
CALL TControl.FontChanged CALL TControl.FontChanged
@ -30905,8 +30917,8 @@ asm
XCHG ECX, EAX XCHG ECX, EAX
JECXZ @@no_brush JECXZ @@no_brush
MOV [ECX].TGraphicTool.fParentGDITool, EDX MOV [ECX].TGraphicTool.fParentGDITool, EDX
MOV [ECX].TGraphicTool.fOnChange.TMethod.Code, offset[TControl.BrushChanged] MOV [ECX].TGraphicTool.fOnGTChange.TMethod.Code, offset[TControl.BrushChanged]
MOV [ECX].TGraphicTool.fOnChange.TMethod.Data, EBX MOV [ECX].TGraphicTool.fOnGTChange.TMethod.Data, EBX
MOV EAX, EBX MOV EAX, EBX
MOV EDX, ECX MOV EDX, ECX
CALL TControl.BrushChanged CALL TControl.BrushChanged
@ -31013,7 +31025,7 @@ begin
Result.Add2AutoFree( Result.fFont ); Result.Add2AutoFree( Result.fFont );
{$ENDIF USE_AUTOFREE4CONTROLS} {$ENDIF USE_AUTOFREE4CONTROLS}
Result.fFont.fParentGDITool := AParent.fFont; Result.fFont.fParentGDITool := AParent.fFont;
Result.fFont.fOnChange := Result.FontChanged; Result.fFont.fOnGTChange := Result.FontChanged;
Result.FontChanged( Result.fFont ); Result.FontChanged( Result.fFont );
end; end;
{$ENDIF WIN_GDI} {$ENDIF WIN_GDI}
@ -31027,7 +31039,7 @@ begin
Result.Add2AutoFree( Result.fBrush ); Result.Add2AutoFree( Result.fBrush );
{$ENDIF USE_AUTOFREE4CONTROLS} {$ENDIF USE_AUTOFREE4CONTROLS}
Result.fBrush.fParentGDITool := AParent.fBrush; Result.fBrush.fParentGDITool := AParent.fBrush;
Result.fBrush.fOnChange := Result.BrushChanged; Result.fBrush.fOnGTChange := Result.BrushChanged;
Result.BrushChanged( Result.fBrush ); Result.BrushChanged( Result.fBrush );
end; end;
{$ENDIF WIN_GDI} {$ENDIF WIN_GDI}
@ -35661,7 +35673,6 @@ end;
{$ENDIF USE_CONSTRUCTORS} {$ENDIF USE_CONSTRUCTORS}
//===================== Tree view ========================// //===================== Tree view ========================//
{$IFDEF ASM_UNICODE} {$IFDEF ASM_UNICODE}
function WndProcTreeView( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; function WndProcTreeView( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
asm //cmd //opd asm //cmd //opd
@ -57127,7 +57138,11 @@ var
//CFW: PCharFormat2W; //CFW: PCharFormat2W;
FS: TFontStyle; FS: TFontStyle;
begin begin
CF := @DF.fRECharFormatRec; {$IFDEF STATIC_RICHEDIT_DATA}
CF := @ DF.fRECharFormatRec;
{$ELSE}
CF := DF.fRECharFormatRec;
{$ENDIF}
ZeroMemory( CF, Sizeof( CF^ ) ); ZeroMemory( CF, Sizeof( CF^ ) );
{$IFDEF UNICODE_CTRLS} {$IFDEF UNICODE_CTRLS}
CF.cbSize := Sizeof( CF^ ); CF.cbSize := Sizeof( CF^ );
@ -57162,7 +57177,7 @@ begin
{$IFDEF UNICODE_CTRLS} {$IFDEF UNICODE_CTRLS}
{$ELSE} {$ELSE}
if (PWord( @CF.szFaceName[0] )^ shr 8) <> 0 then if (PWord( @CF.szFaceName[0] )^ shr 8) <> 0 then
Result.FontName := AnsiString(@CF.szFaceName[0]) // real T,0 works fine. Result.FontName := PAnsiChar(@CF.szFaceName[0]) // real T,0 works fine.
else else
{$ENDIF} {$ENDIF}
Result.FontName := KOLString(PWideChar(@CF.szFaceName[0])); Result.FontName := KOLString(PWideChar(@CF.szFaceName[0]));
@ -57176,7 +57191,11 @@ procedure TControl.RESetFontEx(const Index: Integer);
var CF: PCharFormat; var CF: PCharFormat;
FS: TFontStyle; FS: TFontStyle;
begin begin
CF := @DF.fRECharFormatRec; {$IFDEF STATIC_RICHEDIT_DATA}
CF := @ DF.fRECharFormatRec;
{$ELSE}
CF := DF.fRECharFormatRec;
{$ENDIF}
ZeroMemory( CF, {82} sizeof( CF^ ) ); ZeroMemory( CF, {82} sizeof( CF^ ) );
{$IFDEF UNICODE_CTRLS} {$IFDEF UNICODE_CTRLS}
CF.cbSize := Sizeof( CF^ ); CF.cbSize := Sizeof( CF^ );
@ -57230,9 +57249,17 @@ var
CF: PCharFormat; CF: PCharFormat;
begin begin
ReGetFont; ReGetFont;
CF := @DF.fRECharFormatRec; {$IFDEF STATIC_RICHEDIT_DATA}
CF := @ DF.fRECharFormatRec;
{$ELSE}
CF := DF.fRECharFormatRec;
{$ENDIF}
{
CF.dwEffects := $FFFFFFFF and Index; CF.dwEffects := $FFFFFFFF and Index;
if not Value then CF.dwEffects := 0; if not Value then CF.dwEffects := 0;
}
CF.dwEffects := CF.dwEffects or DWORD( Index );
if not Value then CF.dwEffects := CF.dwEffects and not Index;
CF.dwMask := Index; CF.dwMask := Index;
Perform( EM_SETCHARFORMAT, RichAreas[ DF.fRECharArea ], Integer( CF ) ); Perform( EM_SETCHARFORMAT, RichAreas[ DF.fRECharArea ], Integer( CF ) );
end; end;
@ -57254,7 +57281,11 @@ var CF: PDWORD;
Mask: DWORD; Mask: DWORD;
begin begin
REGetFont; REGetFont;
CF := Pointer( Integer( @DF.fRECharFormatRec ) + (HiWord(Index) and $7E) ); {$IFDEF STATIC_RICHEDIT_DATA}
CF := Pointer( Integer( @ DF.fRECharFormatRec ) + (HiWord(Index) and $7E) );
{$ELSE}
CF := Pointer( Integer( DF.fRECharFormatRec ) + (HiWord(Index) and $7E) );
{$ENDIF}
Mask := 0; Mask := 0;
if LongBool( HiWord(Index) and $1 ) then if LongBool( HiWord(Index) and $1 ) then
Mask := $FFFFFF00; Mask := $FFFFFF00;
@ -57885,7 +57916,8 @@ begin
if _Self_.SelLength = 0 then if _Self_.SelLength = 0 then
_Self_.SelLength := 1; _Self_.SelLength := 1;
_Self_.Perform( EM_SETCHARFORMAT, SCF_SELECTION { RichAreas[ _Self_.fRECharArea ] }, _Self_.Perform( EM_SETCHARFORMAT, SCF_SELECTION { RichAreas[ _Self_.fRECharArea ] },
Integer( @_Self_.DF.fRECharFormatRec ) ); Integer( {$IFDEF STATIC_RICHEDIT_DATA} @_Self_.DF.fRECharFormatRec
{$ELSE} _Self_.DF.fRECharFormatRec {$ENDIF} ) );
end; end;
end; end;
end; end;
@ -61693,7 +61725,9 @@ begin
else else
begin begin
Applet.EV.fOnMessage := Applet.EV.fOldOnMessage; Applet.EV.fOnMessage := Applet.EV.fOldOnMessage;
Applet.EV.fOldOnMessage := nil; Applet.EV.fOldOnMessage :=
{$IFDEF SAFEST_CODE} TOnMessage( MakeMethod( nil, @ DummyProc123_0 ) )
{$ELSE} nil {$ENDIF};
end; end;
C := nil; C := nil;
if Value then C := @ Self; if Value then C := @ Self;
@ -64749,6 +64783,8 @@ begin C := Form;
C.SetName( Form, Form.FormString ); C.SetName( Form, Form.FormString );
end; end;
{$ENDIF USE_NAMES}////////////////////////////////////////////////////////////// {$ENDIF USE_NAMES}//////////////////////////////////////////////////////////////
procedure FormSetTag( Form: PControl );
begin Form.Tag := ParentForm_IntParamPas(Form); end;
{$IFDEF UNICODE_CTRLS} {$IFDEF UNICODE_CTRLS}
procedure FormSetUnicode( Form: PControl ); procedure FormSetUnicode( Form: PControl );
begin Form.SetUnicode( TRUE ); end; begin Form.SetUnicode( TRUE ); end;
@ -65153,21 +65189,23 @@ procedure FormSetTBBtnImgWidth( Form: PControl );
begin Form.TBBtnImgWidth := ParentForm_IntParamPas( Form ); begin Form.TBBtnImgWidth := ParentForm_IntParamPas( Form );
end;//////////////////////////////////////////////////////////////////////////// end;////////////////////////////////////////////////////////////////////////////
procedure FormTBAddBitmap( Form: PControl ); procedure FormTBAddBitmap( Form: PControl );
var m: Boolean; var map: array[ 0..1 ] of TColor;
map: array[ 0..1 ] of TColor;
b: Integer; b: Integer;
C: PControl; C: PControl;
begin C := Form; begin C := Form;
Form := Form.ParentForm; Form := Form.ParentForm;
Form.FormGetStrParam; b := Form.FormGetIntParam;
m := Form.FormGetIntParam <> 0; if b >= 0 then
if m then
begin begin
map[0] := Form.FormGetColorParam; Form.FormGetStrParam;
map[1] := Color2RGB( clBtnFace ); if b <> 0 then
b := LoadMappedBitmapEx( Form, hInstance, PKOLChar( KOLString( Form.FormString )), map ); begin
end else map[0] := Form.FormGetColorParam;
b := LoadBmp( hInstance, PKOLChar(KOLString(Form.FormString)), Form ); map[1] := Color2RGB( clBtnFace );
b := LoadMappedBitmapEx( Form, hInstance, PKOLChar( KOLString( Form.FormString )), map );
end else
b := LoadBmp( hInstance, PKOLChar(KOLString(Form.FormString)), Form );
end;
C.TBAddBitmap( b ); C.TBAddBitmap( b );
end;//////////////////////////////////////////////////////////////////////////// end;////////////////////////////////////////////////////////////////////////////
procedure FormSetTBButtonSize( Form: PControl ); procedure FormSetTBButtonSize( Form: PControl );
@ -65512,7 +65550,7 @@ begin Result := EV.fOnDropFiles; end;
{$ENDIF EVENTS_DYNAMIC}//------------------------------------------------------- {$ENDIF EVENTS_DYNAMIC}//-------------------------------------------------------
{$IFnDEF NOT_USE_RICHEDIT} {$IFnDEF NOT_USE_RICHEDIT}
procedure TControl.FreeCharFormatRec; procedure TControl.FreeCharFormatRec;
begin FreeMem( DF.fRECharFormatRec ); end; begin {$IFnDEF STATIC_RICHEDIT_DATA} FreeMem( DF.fRECharFormatRec ); {$ENDIF} end;
{$ENDIF} {$ENDIF}
function TControl.GetAnchor(const Index: Integer): Boolean; function TControl.GetAnchor(const Index: Integer): Boolean;
begin Result := fAnchors and Index <> 0; end; begin Result := fAnchors and Index <> 0; end;

7
KOLDirDlgEx.pas
View File

@ -450,7 +450,7 @@ begin
DTSubPanel.SetAlign( caClient ); DTSubPanel.SetAlign( caClient );
DirTree := NewTreeView( DTSubPanel, [ tvoLinesRoot ], Sysimages, nil ); DirTree := NewTreeView( DTSubPanel, [ tvoLinesRoot ], Sysimages, nil );
{$IFNDEF DIRDLGEX_NO_DBLCLK_ON_NODE_OK} {$IFNDEF DIRDLGEX_NO_DBLCLK_ON_NODE_OK}
//DirTree.OnMouseDblClk := DoubleClick; DirTree.OnMouseDblClk := DoubleClick;
{$ENDIF} {$ENDIF}
DirTree.Color := clWindow; DirTree.Color := clWindow;
DirTree.OnTVExpanding := DoExpanding; DirTree.OnTVExpanding := DoExpanding;
@ -507,11 +507,6 @@ begin
end; end;
{$ENDIF USE_GRUSH} {$ENDIF USE_GRUSH}
end; end;
{$IFNDEF DIRDLGEX_NO_DBLCLK_ON_NODE_OK}
DirTree.OnMouseDblClk := DoubleClick;
{$ENDIF}
end; end;
{$IFDEF DIRDLGEX_LINKSPANEL} {$IFDEF DIRDLGEX_LINKSPANEL}

20
KOL_ASM.inc
View File

@ -1,6 +1,6 @@
//------------------------------------------------------------------------------ //------------------------------------------------------------------------------
// KOL_ASM.inc ()to be inlude in KOL.pas) // KOL_ASM.inc ()to be inlude in KOL.pas)
// v 3.00.z9 // v 3.03
function MsgBox( const S: KOLString; Flags: DWORD ): DWORD; function MsgBox( const S: KOLString; Flags: DWORD ): DWORD;
asm asm
@ -679,6 +679,8 @@ end;
procedure Run( var AppletWnd: PControl ); procedure Run( var AppletWnd: PControl );
asm asm
CMP EAX, 0
JZ @@exit
PUSH EBX PUSH EBX
XCHG EBX, EAX XCHG EBX, EAX
INC [AppletRunning] INC [AppletRunning]
@ -893,11 +895,11 @@ asm
@@exit: @@exit:
@@CallOnChange: @@CallOnChange:
MOV ECX, [EAX].fOnChange.TMethod.Code MOV ECX, [EAX].fOnGTChange.TMethod.Code
JECXZ @@no_onChange JECXZ @@no_onChange
PUSH EAX PUSH EAX
XCHG EDX, EAX XCHG EDX, EAX
MOV EAX, [EDX].fOnChange.TMethod.Data MOV EAX, [EDX].fOnGTChange.TMethod.Data
CALL ECX CALL ECX
POP EAX POP EAX
@@no_onChange: @@no_onChange:
@ -2335,8 +2337,8 @@ asm
@@1: LODSD @@1: LODSD
TEST EAX, EAX TEST EAX, EAX
JZ @@nxt JZ @@nxt
MOV [EAX].TGraphicTool.fOnChange.TMethod.Data, EDX MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Data, EDX
MOV [EAX].TGraphicTool.fOnChange.TMethod.Code, offset[ ObjectChanged ] MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Code, offset[ ObjectChanged ]
@@nxt: DEC CL @@nxt: DEC CL
JNZ @@1 JNZ @@1
POP ESI POP ESI
@ -7652,8 +7654,8 @@ asm
MOV [EDX].FFont, EAX MOV [EDX].FFont, EAX
MOV ECX, [EDX].fTextColor MOV ECX, [EDX].fTextColor
MOV [EAX].TGraphicTool.fData.Color, ECX MOV [EAX].TGraphicTool.fData.Color, ECX
MOV [EAX].TGraphicTool.fOnChange.TMethod.Code, offset[FontChanged] MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Code, offset[FontChanged]
MOV [EAX].TGraphicTool.fOnChange.TMethod.Data, EDX MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Data, EDX
RET RET
@@exit: XCHG EAX, ECX @@exit: XCHG EAX, ECX
end; end;
@ -7669,8 +7671,8 @@ asm
MOV [EDX].FBrush, EAX MOV [EDX].FBrush, EAX
MOV ECX, [EDX].fColor MOV ECX, [EDX].fColor
MOV [EAX].TGraphicTool.fData.Color, ECX MOV [EAX].TGraphicTool.fData.Color, ECX
MOV [EAX].TGraphicTool.fOnChange.TMethod.Code, offset[BrushChanged] MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Code, offset[BrushChanged]
MOV [EAX].TGraphicTool.fOnChange.TMethod.Data, EDX MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Data, EDX
{$IFDEF USE_AUTOFREE4CONTROLS} {$IFDEF USE_AUTOFREE4CONTROLS}
PUSH EAX PUSH EAX
XCHG EAX, EDX XCHG EAX, EDX

7
KOLadd.pas
View File

@ -2328,8 +2328,11 @@ begin
OnChange := nil; OnChange := nil;
SetEvent( FinEvent ); SetEvent( FinEvent );
end; end;
FMonitor.WaitFor; if FMonitor <> nil then
FMonitor.Free; begin
FMonitor.WaitFor;
FMonitor.Free;
end;
CloseHandle( FinEvent ); CloseHandle( FinEvent );
FPath := ''; FPath := '';
inherited; inherited;

2
mckCtrls.pas
View File

@ -11810,8 +11810,8 @@ begin
if (KF <> nil) and KF.FormCompact then if (KF <> nil) and KF.FormCompact then
begin begin
KF.FormAddCtlCommand( Name, 'FormTBAddBitmap' ); KF.FormAddCtlCommand( Name, 'FormTBAddBitmap' );
KF.FormAddStrParameter( RsrcName );
KF.FormAddNumParameter( Integer(mapBitmapColors) ); KF.FormAddNumParameter( Integer(mapBitmapColors) );
KF.FormAddStrParameter( RsrcName );
if mapBitmapColors then if mapBitmapColors then
KF.FormAddNumParameter( (FBmpTranColor shl 1) or (FBmpTranColor shr 31) ); KF.FormAddNumParameter( (FBmpTranColor shl 1) or (FBmpTranColor shr 31) );
end end

26
mirror.pas
View File

@ -19,7 +19,7 @@ mmmmm mmmmm mmmmm cccccccccccc kkkkk kkkkk
Key Objects Library (C) 1999 by Kladov Vladimir. Key Objects Library (C) 1999 by Kladov Vladimir.
KOL Mirror Classes Kit (C) 2000 by Kladov Vladimir. KOL Mirror Classes Kit (C) 2000 by Kladov Vladimir.
******************************************************** ********************************************************
* VERSION 3.01 * VERSION 3.03
******************************************************** ********************************************************
} }
unit mirror; unit mirror;
@ -4711,7 +4711,7 @@ begin
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
[ 'OnClick:^TControl.SetOnClick', [ 'OnClick:^TControl.SetOnClick',
'OnMouseDblClk:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseDblClk), 'OnMouseDblClk:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseDblClk),
'OnMessage: TControl.SetOnMessage', 'OnMessage: TControl.Set_OnMessage',
'OnMouseDown:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseDown), 'OnMouseDown:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseDown),
'OnMouseMove:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseMove), 'OnMouseMove:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseMove),
'OnMouseUp:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseUp), 'OnMouseUp:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseUp),
@ -18225,7 +18225,9 @@ end;
procedure TKOLForm.SetGenerateCtlNames(const Value: Boolean); procedure TKOLForm.SetGenerateCtlNames(const Value: Boolean);
begin begin
if FGenerateCtlNames = Value then Exit;
FGenerateCtlNames := Value; FGenerateCtlNames := Value;
Change( Self );
end; end;
function TKOLForm.FormFlushedCompact: Boolean; function TKOLForm.FormFlushedCompact: Boolean;
@ -21542,20 +21544,18 @@ end;
procedure TKOLObj.SetupName(SL: TStringList; const AName, AParent, procedure TKOLObj.SetupName(SL: TStringList; const AName, AParent,
Prefix: String ); Prefix: String );
var KF: TKOLForm;
begin begin
if FNameSetuped then Exit; if FNameSetuped then Exit;
if Name <> '' then KF := ParentKOLForm;
if KF = nil then Exit;
if (Name <> '') and KF.GenerateCtlNames then
begin begin
SL.Add( ' {$IFDEF USE_NAMES}' ); if AParent <> 'nil' then
//SL.Add( Prefix + AName + '.Name := ''' + Name + ''';' ); SL.Add(Format( '%s%s.SetName( Result.Form, ''%s'' ); ', [Prefix, AName, Name]))
else
if AParent <> 'nil' then SL.Add(Format( '%s%s.SetName( Result, ''%s'' ); ', [Prefix, AName, Name]));
Sl.Add(Format( '%s%s.SetName( Result.Form, ''%s'' ); ', [Prefix, AName, Name])) FNameSetuped := TRUE;
else
Sl.Add(Format( '%s%s.SetName( Result, ''%s'' ); ', [Prefix, AName, Name]));
SL.Add( ' {$ENDIF}' );
FNameSetuped := TRUE;
end; end;
end; end;