From ed2c4a3dcfffc0a56c1c18d22bf62379516ee0c2 Mon Sep 17 00:00:00 2001 From: dkolmck Date: Sat, 18 Dec 2010 13:30:16 +0000 Subject: [PATCH] 3.03 git-svn-id: https://svn.code.sf.net/p/kolmck/code@96 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07 --- Addons/tinyJPGGIFBMP.pas | 12 ++-- KOL.pas | 122 +++++++++++++++++++++++++-------------- KOLDirDlgEx.pas | 7 +-- KOL_ASM.inc | 20 ++++--- KOLadd.pas | 7 ++- mckCtrls.pas | 2 +- mirror.pas | 26 ++++----- 7 files changed, 119 insertions(+), 77 deletions(-) diff --git a/Addons/tinyJPGGIFBMP.pas b/Addons/tinyJPGGIFBMP.pas index 3b1b0ab..00109ce 100644 --- a/Addons/tinyJPGGIFBMP.pas +++ b/Addons/tinyJPGGIFBMP.pas @@ -11,9 +11,12 @@ unit tinyJPGGIFBMP; 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 tinyLoadJPGGIFBMPMemory(var TargetBitmap: PBitMap; Ptr: HGlobal; Size: DWORD); @@ -21,9 +24,10 @@ procedure tinyLoadJPGGIFBMPResource(var TargetBitmap: PBitMap; Inst : HInst; Res 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'; procedure OleFree( Picta: IPicture ); diff --git a/KOL.pas b/KOL.pas index 06d5a4e..704de8d 100644 --- a/KOL.pas +++ b/KOL.pas @@ -14,7 +14,7 @@ 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 @@ -2165,7 +2165,7 @@ type fParentGDITool: PGraphicTool; {$ENDIF GDI} fColorRGB: TColor; - fOnChange: TOnGraphicChange; + fOnGTChange: TOnGraphicChange; fData: TGDIToolData; fNewProc: TNewGraphicTool; {$IFDEF GDI} @@ -2239,7 +2239,7 @@ type {* Returns True, if handle is allocated (i.e., if real GDI objet is created. } {$ENDIF GDI} - property OnChange: TOnGraphicChange read fOnChange write fOnChange; + property OnChange: TOnGraphicChange read fOnGTChange write fOnGTChange; {* Called, when object is changed. } {$IFDEF GDI} function ReleaseHandle: Integer; @@ -5216,7 +5216,9 @@ type function REGetLangOptions(const Index: Integer): Boolean; procedure RESetLangOptions(const Index: Integer; const Value: Boolean); {$ENDIF NOT_USE_RICHEDIT} + public procedure SetOnResize(const Value: TOnEvent); + protected procedure DoSelChange; function LVGetItemImgIdx(Idx: Integer): Integer; procedure LVSetItemImgIdx(Idx: Integer; const Value: Integer); @@ -5280,10 +5282,12 @@ type function GetLVCurItem: Integer; procedure SetLVCurItem(const Value: Integer); function GetLVFocusItem: Integer; + public procedure SetOnDropFiles(const Value: TOnDropFiles); procedure SetOnHide(const Value: TOnEvent); procedure SetOnShow(const Value: TOnEvent); procedure SetClientMargin(const Index: Integer; Value: ShortInt); + protected {$IFDEF F_P} function GetClientMargin(const Index: Integer): Integer; {$ENDIF F_P} @@ -5294,6 +5298,7 @@ type {} fExposeEvent: Integer; {$ENDIF GTK} {$ENDIF _X_} + public procedure SetOnPaint(const Value: TOnPaint); {$IFDEF GDI} procedure SetOnEraseBkgnd(const Value: TOnPaint); @@ -6266,7 +6271,16 @@ type |<#richedit> Replaces selection (in edit, RichEdit). Unlike assigning new value to Selection property, it is possible to specify, if operation can - be undone. } + be undone. + |
+ 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 ); {* |<#edit> @@ -6914,7 +6928,7 @@ type {* Name of window class - unique for every window class in every run session of a program. } - protected + public procedure SetOnClose( const AOnClose: TOnEventAccept ); procedure SetFormOnClick( const AOnClick: TOnEvent ); public @@ -9521,6 +9535,7 @@ procedure FormSetWidth( Form: PControl ); procedure FormSetPosition( Form: PControl ); procedure FormSetClientSize( Form: PControl ); procedure FormSetAlign( Form: PControl ); +procedure FormSetTag( Form: PControl ); {$IFDEF USE_NAMES} procedure FormSetName( Form: PControl ); {$ENDIF USE_NAMES} @@ -17417,6 +17432,7 @@ var n: Integer; M: TMsg; {$ENDIF} begin + if AppletWnd = nil then Exit; AppletRunning := True; Applet := AppletWnd; AppletWnd.CreateWindow; //virtual!!! @@ -17774,8 +17790,8 @@ begin fHandle := 0; end; //////////////////////////////// - if Assigned( fOnChange ) then - fOnChange( @Self ); + if Assigned( TMethod( fOnGTChange ).Data ) then + fOnGTChange( @Self ); //////////////////////////////// if H <> 0 then begin @@ -19407,11 +19423,11 @@ END; procedure TCanvas.AssignChangeEvents; begin if ( fBrush <> nil ) then - fBrush.fOnChange := ObjectChanged; + fBrush.fOnGTChange := ObjectChanged; if ( fPen <> nil ) then - fPen.fOnChange := ObjectChanged; + fPen.fOnGTChange := ObjectChanged; if ( fFont <> nil ) then - fFont.fOnChange := ObjectChanged; + fFont.fOnGTChange := ObjectChanged; end; {$ENDIF ASM_VERSION} {$IFDEF WIN_GDI} @@ -30833,13 +30849,6 @@ asm MOV CL, Sz_TCommandActions REP MOVSB POP ESI - { - LEA EDX, [EBX].TControl.fCommandActions - XCHG EAX, EDI - XOR ECX, ECX - MOV CL, Sz_TCommandActions - CALL Move - } JMP @@actions_created @@no_actions2: MOV [EBX].TControl.fCommandActions.TCommandActions.aClear, offset[ClearText] @@ -30849,6 +30858,9 @@ asm TEST ESI, ESI JZ @@no_parent + MOV EAX, [ESI].TControl.PP.fGotoControl + MOV [EBX].TControl.PP.fGotoControl, EAX + LEA ESI, [ESI].TControl.fTextColor LEA EDI, [EBX].TControl.fTextColor MOVSD // fTextColor @@ -30877,8 +30889,8 @@ asm XCHG ECX, EAX JECXZ @@no_font MOV [ECX].TGraphicTool.fParentGDITool, EDX - MOV [ECX].TGraphicTool.fOnChange.TMethod.Code, offset[TControl.FontChanged] - MOV [ECX].TGraphicTool.fOnChange.TMethod.Data, EBX + MOV [ECX].TGraphicTool.fOnGTChange.TMethod.Code, offset[TControl.FontChanged] + MOV [ECX].TGraphicTool.fOnGTChange.TMethod.Data, EBX MOV EAX, EBX MOV EDX, ECX CALL TControl.FontChanged @@ -30905,8 +30917,8 @@ asm XCHG ECX, EAX JECXZ @@no_brush MOV [ECX].TGraphicTool.fParentGDITool, EDX - MOV [ECX].TGraphicTool.fOnChange.TMethod.Code, offset[TControl.BrushChanged] - MOV [ECX].TGraphicTool.fOnChange.TMethod.Data, EBX + MOV [ECX].TGraphicTool.fOnGTChange.TMethod.Code, offset[TControl.BrushChanged] + MOV [ECX].TGraphicTool.fOnGTChange.TMethod.Data, EBX MOV EAX, EBX MOV EDX, ECX CALL TControl.BrushChanged @@ -31013,7 +31025,7 @@ begin Result.Add2AutoFree( Result.fFont ); {$ENDIF USE_AUTOFREE4CONTROLS} Result.fFont.fParentGDITool := AParent.fFont; - Result.fFont.fOnChange := Result.FontChanged; + Result.fFont.fOnGTChange := Result.FontChanged; Result.FontChanged( Result.fFont ); end; {$ENDIF WIN_GDI} @@ -31027,7 +31039,7 @@ begin Result.Add2AutoFree( Result.fBrush ); {$ENDIF USE_AUTOFREE4CONTROLS} Result.fBrush.fParentGDITool := AParent.fBrush; - Result.fBrush.fOnChange := Result.BrushChanged; + Result.fBrush.fOnGTChange := Result.BrushChanged; Result.BrushChanged( Result.fBrush ); end; {$ENDIF WIN_GDI} @@ -35661,7 +35673,6 @@ end; {$ENDIF USE_CONSTRUCTORS} //===================== Tree view ========================// - {$IFDEF ASM_UNICODE} function WndProcTreeView( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; asm //cmd //opd @@ -57127,7 +57138,11 @@ var //CFW: PCharFormat2W; FS: TFontStyle; begin - CF := @DF.fRECharFormatRec; + {$IFDEF STATIC_RICHEDIT_DATA} + CF := @ DF.fRECharFormatRec; + {$ELSE} + CF := DF.fRECharFormatRec; + {$ENDIF} ZeroMemory( CF, Sizeof( CF^ ) ); {$IFDEF UNICODE_CTRLS} CF.cbSize := Sizeof( CF^ ); @@ -57162,7 +57177,7 @@ begin {$IFDEF UNICODE_CTRLS} {$ELSE} 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 {$ENDIF} Result.FontName := KOLString(PWideChar(@CF.szFaceName[0])); @@ -57176,7 +57191,11 @@ procedure TControl.RESetFontEx(const Index: Integer); var CF: PCharFormat; FS: TFontStyle; begin - CF := @DF.fRECharFormatRec; + {$IFDEF STATIC_RICHEDIT_DATA} + CF := @ DF.fRECharFormatRec; + {$ELSE} + CF := DF.fRECharFormatRec; + {$ENDIF} ZeroMemory( CF, {82} sizeof( CF^ ) ); {$IFDEF UNICODE_CTRLS} CF.cbSize := Sizeof( CF^ ); @@ -57230,9 +57249,17 @@ var CF: PCharFormat; begin ReGetFont; - CF := @DF.fRECharFormatRec; + {$IFDEF STATIC_RICHEDIT_DATA} + CF := @ DF.fRECharFormatRec; + {$ELSE} + CF := DF.fRECharFormatRec; + {$ENDIF} + { CF.dwEffects := $FFFFFFFF and Index; 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; Perform( EM_SETCHARFORMAT, RichAreas[ DF.fRECharArea ], Integer( CF ) ); end; @@ -57254,7 +57281,11 @@ var CF: PDWORD; Mask: DWORD; begin 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; if LongBool( HiWord(Index) and $1 ) then Mask := $FFFFFF00; @@ -57885,7 +57916,8 @@ begin if _Self_.SelLength = 0 then _Self_.SelLength := 1; _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; @@ -61693,7 +61725,9 @@ begin else begin 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; C := nil; if Value then C := @ Self; @@ -64749,6 +64783,8 @@ begin C := Form; C.SetName( Form, Form.FormString ); end; {$ENDIF USE_NAMES}////////////////////////////////////////////////////////////// +procedure FormSetTag( Form: PControl ); +begin Form.Tag := ParentForm_IntParamPas(Form); end; {$IFDEF UNICODE_CTRLS} procedure FormSetUnicode( Form: PControl ); begin Form.SetUnicode( TRUE ); end; @@ -65153,21 +65189,23 @@ procedure FormSetTBBtnImgWidth( Form: PControl ); begin Form.TBBtnImgWidth := ParentForm_IntParamPas( Form ); end;//////////////////////////////////////////////////////////////////////////// procedure FormTBAddBitmap( Form: PControl ); -var m: Boolean; - map: array[ 0..1 ] of TColor; +var map: array[ 0..1 ] of TColor; b: Integer; C: PControl; begin C := Form; Form := Form.ParentForm; - Form.FormGetStrParam; - m := Form.FormGetIntParam <> 0; - if m then + b := Form.FormGetIntParam; + if b >= 0 then begin - map[0] := Form.FormGetColorParam; - map[1] := Color2RGB( clBtnFace ); - b := LoadMappedBitmapEx( Form, hInstance, PKOLChar( KOLString( Form.FormString )), map ); - end else - b := LoadBmp( hInstance, PKOLChar(KOLString(Form.FormString)), Form ); + Form.FormGetStrParam; + if b <> 0 then + begin + map[0] := Form.FormGetColorParam; + 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 ); end;//////////////////////////////////////////////////////////////////////////// procedure FormSetTBButtonSize( Form: PControl ); @@ -65512,7 +65550,7 @@ begin Result := EV.fOnDropFiles; end; {$ENDIF EVENTS_DYNAMIC}//------------------------------------------------------- {$IFnDEF NOT_USE_RICHEDIT} procedure TControl.FreeCharFormatRec; -begin FreeMem( DF.fRECharFormatRec ); end; +begin {$IFnDEF STATIC_RICHEDIT_DATA} FreeMem( DF.fRECharFormatRec ); {$ENDIF} end; {$ENDIF} function TControl.GetAnchor(const Index: Integer): Boolean; begin Result := fAnchors and Index <> 0; end; diff --git a/KOLDirDlgEx.pas b/KOLDirDlgEx.pas index b3f98ea..6855f22 100644 --- a/KOLDirDlgEx.pas +++ b/KOLDirDlgEx.pas @@ -450,7 +450,7 @@ begin DTSubPanel.SetAlign( caClient ); DirTree := NewTreeView( DTSubPanel, [ tvoLinesRoot ], Sysimages, nil ); {$IFNDEF DIRDLGEX_NO_DBLCLK_ON_NODE_OK} - //DirTree.OnMouseDblClk := DoubleClick; + DirTree.OnMouseDblClk := DoubleClick; {$ENDIF} DirTree.Color := clWindow; DirTree.OnTVExpanding := DoExpanding; @@ -507,11 +507,6 @@ begin end; {$ENDIF USE_GRUSH} end; - - {$IFNDEF DIRDLGEX_NO_DBLCLK_ON_NODE_OK} - DirTree.OnMouseDblClk := DoubleClick; - {$ENDIF} - end; {$IFDEF DIRDLGEX_LINKSPANEL} diff --git a/KOL_ASM.inc b/KOL_ASM.inc index 30c8610..ed66f97 100644 --- a/KOL_ASM.inc +++ b/KOL_ASM.inc @@ -1,6 +1,6 @@ //------------------------------------------------------------------------------ // KOL_ASM.inc ()to be inlude in KOL.pas) -// v 3.00.z9 +// v 3.03 function MsgBox( const S: KOLString; Flags: DWORD ): DWORD; asm @@ -679,6 +679,8 @@ end; procedure Run( var AppletWnd: PControl ); asm + CMP EAX, 0 + JZ @@exit PUSH EBX XCHG EBX, EAX INC [AppletRunning] @@ -893,11 +895,11 @@ asm @@exit: @@CallOnChange: - MOV ECX, [EAX].fOnChange.TMethod.Code + MOV ECX, [EAX].fOnGTChange.TMethod.Code JECXZ @@no_onChange PUSH EAX XCHG EDX, EAX - MOV EAX, [EDX].fOnChange.TMethod.Data + MOV EAX, [EDX].fOnGTChange.TMethod.Data CALL ECX POP EAX @@no_onChange: @@ -2335,8 +2337,8 @@ asm @@1: LODSD TEST EAX, EAX JZ @@nxt - MOV [EAX].TGraphicTool.fOnChange.TMethod.Data, EDX - MOV [EAX].TGraphicTool.fOnChange.TMethod.Code, offset[ ObjectChanged ] + MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Data, EDX + MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Code, offset[ ObjectChanged ] @@nxt: DEC CL JNZ @@1 POP ESI @@ -7652,8 +7654,8 @@ asm MOV [EDX].FFont, EAX MOV ECX, [EDX].fTextColor MOV [EAX].TGraphicTool.fData.Color, ECX - MOV [EAX].TGraphicTool.fOnChange.TMethod.Code, offset[FontChanged] - MOV [EAX].TGraphicTool.fOnChange.TMethod.Data, EDX + MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Code, offset[FontChanged] + MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Data, EDX RET @@exit: XCHG EAX, ECX end; @@ -7669,8 +7671,8 @@ asm MOV [EDX].FBrush, EAX MOV ECX, [EDX].fColor MOV [EAX].TGraphicTool.fData.Color, ECX - MOV [EAX].TGraphicTool.fOnChange.TMethod.Code, offset[BrushChanged] - MOV [EAX].TGraphicTool.fOnChange.TMethod.Data, EDX + MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Code, offset[BrushChanged] + MOV [EAX].TGraphicTool.fOnGTChange.TMethod.Data, EDX {$IFDEF USE_AUTOFREE4CONTROLS} PUSH EAX XCHG EAX, EDX diff --git a/KOLadd.pas b/KOLadd.pas index 5ea3f67..c25144c 100644 --- a/KOLadd.pas +++ b/KOLadd.pas @@ -2328,8 +2328,11 @@ begin OnChange := nil; SetEvent( FinEvent ); end; - FMonitor.WaitFor; - FMonitor.Free; + if FMonitor <> nil then + begin + FMonitor.WaitFor; + FMonitor.Free; + end; CloseHandle( FinEvent ); FPath := ''; inherited; diff --git a/mckCtrls.pas b/mckCtrls.pas index 2038d14..e4cfa78 100644 --- a/mckCtrls.pas +++ b/mckCtrls.pas @@ -11810,8 +11810,8 @@ begin if (KF <> nil) and KF.FormCompact then begin KF.FormAddCtlCommand( Name, 'FormTBAddBitmap' ); - KF.FormAddStrParameter( RsrcName ); KF.FormAddNumParameter( Integer(mapBitmapColors) ); + KF.FormAddStrParameter( RsrcName ); if mapBitmapColors then KF.FormAddNumParameter( (FBmpTranColor shl 1) or (FBmpTranColor shr 31) ); end diff --git a/mirror.pas b/mirror.pas index 7250df4..bf0d714 100644 --- a/mirror.pas +++ b/mirror.pas @@ -19,7 +19,7 @@ mmmmm mmmmm mmmmm cccccccccccc kkkkk kkkkk Key Objects Library (C) 1999 by Kladov Vladimir. KOL Mirror Classes Kit (C) 2000 by Kladov Vladimir. ******************************************************** -* VERSION 3.01 +* VERSION 3.03 ******************************************************** } unit mirror; @@ -4711,7 +4711,7 @@ begin // --------------------------------------------------------------------------- [ 'OnClick:^TControl.SetOnClick', 'OnMouseDblClk:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseDblClk), - 'OnMessage: TControl.SetOnMessage', + 'OnMessage: TControl.Set_OnMessage', 'OnMouseDown:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseDown), 'OnMouseMove:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseMove), 'OnMouseUp:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseUp), @@ -18225,7 +18225,9 @@ end; procedure TKOLForm.SetGenerateCtlNames(const Value: Boolean); begin + if FGenerateCtlNames = Value then Exit; FGenerateCtlNames := Value; + Change( Self ); end; function TKOLForm.FormFlushedCompact: Boolean; @@ -21542,20 +21544,18 @@ end; procedure TKOLObj.SetupName(SL: TStringList; const AName, AParent, Prefix: String ); +var KF: TKOLForm; begin if FNameSetuped then Exit; - if Name <> '' then + KF := ParentKOLForm; + if KF = nil then Exit; + if (Name <> '') and KF.GenerateCtlNames then begin - SL.Add( ' {$IFDEF USE_NAMES}' ); - //SL.Add( Prefix + AName + '.Name := ''' + Name + ''';' ); - - if AParent <> 'nil' then - Sl.Add(Format( '%s%s.SetName( Result.Form, ''%s'' ); ', [Prefix, AName, Name])) - else - Sl.Add(Format( '%s%s.SetName( Result, ''%s'' ); ', [Prefix, AName, Name])); - - SL.Add( ' {$ENDIF}' ); - FNameSetuped := TRUE; + if AParent <> 'nil' then + SL.Add(Format( '%s%s.SetName( Result.Form, ''%s'' ); ', [Prefix, AName, Name])) + else + SL.Add(Format( '%s%s.SetName( Result, ''%s'' ); ', [Prefix, AName, Name])); + FNameSetuped := TRUE; end; end;