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

View File

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

122
KOL.pas
View File

@ -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.
|<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 );
{* |<#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;

View File

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

View File

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

View File

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

View File

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

View File

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