pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

* update

Browse Source 
git-svn-id: https://svn.code.sf.net/p/kolmck/code@167 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
2021-03-05 07:43:36 +00:00
parent ba615be61d
commit f74d2dee76
10 changed files with 126 additions and 121 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
Addons/KOLCCtrls.pas
View File

@ -530,11 +530,7 @@ begin
if (Msg.message = WM_HSCROLL) or (Msg.message = WM_VSCROLL) then
if (Msg.lParam <> 0) then
begin
{$IFDEF USE_PROP}
Trackbar := Pointer( GetProp( Msg.lParam, ID_SELF ) );
{$ELSE}
Trackbar := Pointer( GetWindowLongPtr( Msg.lParam, GWLP_USERDATA ) );
{$ENDIF}
if Trackbar <> nil then
begin
D := Trackbar.CustomData;

18
Addons/KOLComObj.pas
View File

@ -815,7 +815,7 @@ begin
if Result.ComClass = ComClass then Exit;
Result := Result.FNext;
end;
raise EOleError.CreateResFmt(e_Ole, Integer( @SObjectFactoryMissing ), [ComClass.ClassName]);
raise EOleError.CreateFmt(e_Ole, SObjectFactoryMissing, [ComClass.ClassName]);
finally
FLock.EndRead;
end;
@ -1246,7 +1246,7 @@ var
ClassName, Description: WideString;
begin
if ComServer.TypeLib.GetTypeInfoOfGUID(ClassID, FClassInfo) <> S_OK then
raise EOleError.CreateResFmt(e_Ole, Integer(@STypeInfoMissing), [TypedComClass.ClassName]);
raise EOleError.CreateFmt(e_Ole, STypeInfoMissing, [TypedComClass.ClassName]);
OleCheck(FClassInfo.GetDocumentation(MEMBERID_NIL, @ClassName,
@Description, nil, nil));
inherited Create(ComServer, TypedComClass, ClassID,
@ -1382,13 +1382,12 @@ begin
inherited Create(ComServer, AutoClass, ClassID, Instancing, ThreadingModel);
FDispTypeInfo := GetInterfaceTypeInfo(IMPLTYPEFLAG_FDEFAULT);
if FDispTypeInfo = nil then
raise EOleError.CreateResFmt(e_Ole, Integer(@SBadTypeInfo), [AutoClass.ClassName]);
raise EOleError.CreateFmt(e_Ole, SBadTypeInfo, [AutoClass.ClassName]);
OleCheck(FDispTypeInfo.GetTypeAttr(TypeAttr));
FDispIntfEntry := GetIntfEntry(TypeAttr^.guid);
FDispTypeInfo.ReleaseTypeAttr(TypeAttr);
if FDispIntfEntry = nil then
raise EOleError.CreateResFmt(e_Ole, Integer(@SDispIntfMissing),
[AutoClass.ClassName]);
raise EOleError.CreateFmt(e_Ole, SDispIntfMissing, [AutoClass.ClassName]);
FErrorIID := FDispIntfEntry^.IID;
FEventTypeInfo := GetInterfaceTypeInfo(IMPLTYPEFLAG_FDEFAULT or
IMPLTYPEFLAG_FSOURCE);
@ -1588,8 +1587,7 @@ begin
PKOLChar(Value), Length(Value) + 1);
RegCloseKey(Handle);
end;
if Status <> 0 then raise EOleRegistrationError.CreateResFmt(e_Registry,
Integer(@SCreateRegKeyError), [ nil ] );
if Status <> 0 then raise EOleRegistrationError.CreateFmt(e_Registry, SCreateRegKeyError, [nil]);
end;
{ Delete registry key }
@ -1638,7 +1636,7 @@ var
LocalMachine: array [0..MAX_COMPUTERNAME_LENGTH] of KOLchar;
begin
if @CoCreateInstanceEx = nil then
raise Exception.CreateResFmt(e_Com, Integer(@SDCOMNotInstalled), [nil]);
raise Exception.CreateFmt(e_Com, SDCOMNotInstalled, [nil]);
FillChar(ServerInfo, sizeof(ServerInfo), 0);
ServerInfo.pwszName := PWideChar(MachineName);
IID_IUnknown := IUnknown;
@ -1935,7 +1933,7 @@ procedure GetIDsOfNames(const Dispatch: IDispatch; Names: PChar;
procedure RaiseNameException;
begin
raise EOleError.CreateResFmt(e_Com, Integer( @SNoMethod ), [Names]);
raise EOleError.CreateFmt(e_Com, SNoMethod, [Names]);
end;
type
@ -1993,7 +1991,7 @@ procedure VarDispInvoke(Result: PVariant; const Instance: Variant;
procedure RaiseException;
begin
raise EOleError.CreateResFmt(e_Com, Integer( @SVarNotObject ), [ nil ] );
raise EOleError.CreateFmt(e_Com, SVarNotObject, [ nil ] );
end;
var

2
Addons/KOLFontEditor.pas
View File

@ -109,7 +109,7 @@ begin
end; // with
end;
function FontDialogHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;
function FontDialogHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT_PTR; stdcall;
var
_Self : TKOLFontProperty;
R, R2, SR : TRect;

39
Addons/KOLMath.pas
View File

@ -303,11 +303,50 @@ function count_1_bits_in_byte( x: Byte ): Byte;
function count_1_bits_in_dword( x: Integer ): Integer;
{* ������������ ����� ��������� ����� � 32-������ }
{ Round to a specific digit or power of ten }
{ ADigit has a valid range of 37 to -37. Here are some valid examples
of ADigit values...
3 = 10^3 = 1000 = thousand's place
2 = 10^2 = 100 = hundred's place
1 = 10^1 = 10 = ten's place
-1 = 10^-1 = 1/10 = tenth's place
-2 = 10^-2 = 1/100 = hundredth's place
-3 = 10^-3 = 1/1000 = thousandth's place }
type
TRoundToRange = -37..37;
function RoundTo(const AValue: Double; const ADigit: TRoundToRange): Double;
{ This variation of the RoundTo function follows the asymmetric arithmetic
rounding algorithm (if Frac(X) < .5 then return X else return X + 1). This
function defaults to rounding to the hundredth's place (cents). }
function SimpleRoundTo(const AValue: Double; const ADigit: TRoundToRange = -2): Double;
implementation
uses SysConst;
function RoundTo(const AValue: Double; const ADigit: TRoundToRange): Double;
var
LFactor: Double;
begin
LFactor := IntPower(10, ADigit);
Result := Round(AValue / LFactor) * LFactor;
end;
function SimpleRoundTo(const AValue: Double; const ADigit: TRoundToRange = -2): Double;
var
LFactor: Double;
begin
LFactor := IntPower(10, ADigit);
if AValue < 0 then
Result := Trunc((AValue / LFactor) - 0.5) * LFactor
else
Result := Trunc((AValue / LFactor) + 0.5) * LFactor;
end;
function EAbs( D: Double ): Double;
begin
Result := D;

3
Addons/KOLPng.pas
View File

@ -2602,9 +2602,6 @@ var
{$IFDEF ASM_VERSION}
Src, Dst: PByte;
CntBytes: Integer;
{$IFDEF SMALLEST_CODE}
Src2: PByte;
{$ENDIF}
{$ELSE}
{$IFDEF PAS_PNG}
{$ELSE}

17
Addons/KOLZLibBzip.pas
View File

@ -192,33 +192,22 @@ function BZDecompressBuf(const InBuf: Pointer; InBytes: Integer;
function BZCompressStream(inStream, outStream: PStream; BlockSize100k: TBlockSize100k = 5): Integer;
function BZDecompressStream(inStream, outStream: PStream): Integer;
{** deflate routines ********************************************************}
function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
recsize: Integer): Integer; external;
function DeflateInit2_(var strm: TZStreamRec; level: integer; method: integer; windowBits: integer;
memLevel: integer; strategy: integer; version: PChar; recsize: integer): integer; external;
function deflate(var strm: TZStreamRec; flush: Integer): Integer;
external;
function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
function deflateEnd(var strm: TZStreamRec): Integer; external;
{** inflate routines ********************************************************}
function inflateInit_(var strm: TZStreamRec; version: PChar;
recsize: Integer): Integer; external;
function inflateInit_(var strm: TZStreamRec; version: PChar; recsize: Integer): Integer; external;
function inflateInit2_(var strm: TZStreamRec; windowBits: integer;
version: PChar; recsize: integer): integer; external;
function inflate(var strm: TZStreamRec; flush: Integer): Integer;
external;
function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
function inflateEnd(var strm: TZStreamRec): Integer; external;
function inflateReset(var strm: TZStreamRec): Integer; external;
const

4
Addons/XPMenus.pas
View File

@ -8,8 +8,6 @@
{ E-mail : alex@diploms.com }
{ �������� �� ������ ������ RyMenu ������� ��������� (skitl@mail.ru). }
{***********************************************************************}
{$DEFINE USE_AUTOFREE4CONTROLS}
unit XPMenus;
interface
@ -173,9 +171,7 @@ begin
end;
PXPControl( AParent).fMenuObj := Result;
AParent.AttachProc(WndProcMenu );
{$IFDEF USE_AUTOFREE4CONTROLS} //dufa
AParent.Add2AutoFree( Result );
{$ENDIF}
end;
end;

116
Addons/mckEcmListEdit.pas
View File

@ -5,30 +5,17 @@ interface
uses
Windows, KOL, Classes, Messages, Forms, SysUtils, mirror,
mckCtrls, Graphics, KOLEcmListEdit,
//////////////////////////////////////////////////
{$IFDEF _D6orHigher} //
DesignIntf, DesignEditors, DesignConst, //
Variants, //
{$ELSE} //
//////////////////////////////////////////////////
DsgnIntf,
//////////////////////////////////////////////////////////
{$ENDIF} //
mckLVColumnsEditor;
mckCtrls, Graphics, KOLEcmListEdit, DesignIntf, DesignEditors, DesignConst, mckLVColumnsEditor;
type
// TOnEditText = procedure (Sender: PControl; ACol, ARow: Integer; var Value: String) of object;
TKOLEcmListEdit = class(TKOLListView)
private
protected
fDrawForbidden: TOnDrawItem;
fListData: boolean;
fListData: Boolean;
fOnGetText: TOnEditText;
fOnPutText: TOnEditText;
fOnEndEdit: TOnEndEdit;
fOnColAdjust: TOnColAdjust;
fOnCellAdjust: TOnCellAdjust;
fOnEditChar: TOnEditChar;
fOnCreateEdit: TOnCreateEdit;
fLimStyle: TKOLListViewStyle;
@ -36,15 +23,14 @@ type
procedure SetOnGetText(const Value: TOnEditText);
procedure SetOnPutText(const Value: TOnEditText);
procedure SetOnEndEdit(const Value: TOnEndEdit);
procedure SetOnColAdjust(const Value: TOnColAdjust);
procedure SetOnCellAdjust(const Value: TOnCellAdjust);
procedure SetOnEditChar(const Value: TOnEditChar);
procedure SetOnCreateEdit(const Value: TOnCreateEdit);
procedure SetLimStyle(const Value: TKOLListViewStyle);
procedure SetOnDrawCell(const Value: TOnDrawCell);
protected
function AdditionalUnits: string; override;
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override;
procedure SetupLast(SL: TStringList; const AName, AParent, Prefix: String); override;
procedure AssignEvents( SL: TStringList; const AName: String ); override;
function SetupParams( const AName, AParent: TDelphiString ): TDelphiString; override;
function GetCaption: string;
@ -62,7 +48,7 @@ type
property OnGetEditText: TOnEditText read fOnGetText write SetOnGetText;
property OnPutEditText: TOnEditText read fOnPutText write SetOnPutText;
property OnStopEdit: TOnEndEdit read fOnEndEdit write SetOnEndEdit;
property OnColAdjust: TOnColAdjust read fOnColAdjust write SetOnColAdjust;
property OnCellAdjust: TOnCellAdjust read fOnCellAdjust write SetOnCellAdjust;
property OnEditChar: TOnEditChar read fOnEditChar write SetOnEditChar;
property OnCreateEdit: TOnCreateEdit read fOnCreateEdit write SetOnCreateEdit;
property OnDrawCell: TOnDrawCell read FOnDrawCell write SetOnDrawCell;
@ -73,17 +59,13 @@ type
implementation
//{$R EcmListEdit.dcr}
constructor TKOLEcmListEdit.Create;
begin
inherited;
inherited Style := lvsDetail;
inherited Options := [{lvoRowSelect,}lvoHideSel,lvoGridLines,lvoOwnerDrawFixed];
// Font.FontCharset := 204;
inherited Options := [{lvoRowSelect,}lvoHideSel, lvoGridLines, lvoOwnerDrawFixed];
end;
function TKOLEcmListEdit.AdditionalUnits;
begin
Result := ', KOLEcmListEdit';
@ -91,40 +73,49 @@ end;
procedure TKOLEcmListEdit.SetupFirst;
begin
// if @fOnGetText <> nil then
// SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnGetEditText := Result.' +
inherited;
end;
procedure TKOLEcmListEdit.SetupLast;
procedure TKOLEcmListEdit.SetupLast(SL: TStringList; const AName, AParent, Prefix: String);
begin
inherited AssignEvents(SL, AName);
if @fOnGetText <> nil then
SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnGetEditText := Result.' +
ParentForm.MethodName( @OnGetEditText ) + ';' );
if @fOnPutText <> nil then
SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnPutEditText := Result.' +
ParentForm.MethodName( @OnPutEditText ) + ';' );
if @fOnEndEdit <> nil then
SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnStopEdit := Result.' +
ParentForm.MethodName( @OnStopEdit ) + ';' );
if @fOnColAdjust <> nil then
SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnColAdjust := Result.' +
ParentForm.MethodName( @OnColAdjust ) + ';' );
if @fOnEditChar <> nil then
SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnEditChar := Result.' +
ParentForm.MethodName( @OnEditChar ) + ';' );
if @fOnCreateEdit <> nil then
SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnCreateEdit := Result.' +
ParentForm.MethodName( @OnCreateEdit ) + ';' );
if @fOnDrawCell <> nil then
SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnDrawCell := Result.' +
ParentForm.MethodName( @OnDrawCell ) + ';' );
inherited;
// inherited AssignEvents(SL, AName);
//
// DoAssignEvents(SL, 'PEcmListEdit(' + AName + '.CustomObj)',
// ['OnGetEditText', 'OnPutEditText', 'OnStopEdit', 'OnCellAdjust', 'OnEditChar', 'OnCreateEdit', 'OnDrawCell'],
// [@OnGetEditText, @OnPutEditText, @OnStopEdit, @fOnCellAdjust, @OnEditChar, @OnCreateEdit, @OnDrawCell]);
// if Assigned(fOnGetText) then begin
// SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnGetEditText := Result.' +
// ParentForm.MethodName(@OnGetEditText) + ';' );
// end;
// if @fOnPutText <> nil then
// SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnPutEditText := Result.' +
// ParentForm.MethodName( @OnPutEditText ) + ';' );
// if @fOnEndEdit <> nil then
// SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnStopEdit := Result.' +
// ParentForm.MethodName( @OnStopEdit ) + ';' );
// if @fOnCellAdjust <> nil then
// SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnCellAdjust := Result.' +
// ParentForm.MethodName( @fOnCellAdjust ) + ';' );
// if @fOnEditChar <> nil then
// SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnEditChar := Result.' +
// ParentForm.MethodName( @OnEditChar ) + ';' );
// if @fOnCreateEdit <> nil then
// SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnCreateEdit := Result.' +
// ParentForm.MethodName( @OnCreateEdit ) + ';' );
// if (@fOnDrawCell <> nil) then
// SL.Add( ' PEcmListEdit(' + AName + '.CustomObj).OnDrawCell := Result.' +
// ParentForm.MethodName( @OnDrawCell ) + ';' );
end;
procedure TKOLEcmListEdit.AssignEvents;
begin
inherited;
DoAssignEvents(SL, 'PEcmListEdit(' + AName + '.CustomObj)',
['OnGetEditText', 'OnPutEditText', 'OnStopEdit', 'OnCellAdjust', 'OnEditChar', 'OnCreateEdit', 'OnDrawCell'],
[@OnGetEditText, @OnPutEditText, @OnStopEdit, @fOnCellAdjust, @OnEditChar, @OnCreateEdit, @OnDrawCell]);
end;
function TKOLEcmListEdit.GetCaption;
@ -161,7 +152,7 @@ end;
procedure TKOLEcmListEdit.SetOnGetText(const Value: TOnEditText);
begin
if @fOnGetText <> @Value then begin
if (@fOnGetText <> @Value) then begin
fOnGetText := Value;
Change();
end;
@ -169,7 +160,7 @@ end;
procedure TKOLEcmListEdit.SetOnPutText(const Value: TOnEditText);
begin
if @fOnPutText <> @Value then begin
if (@fOnPutText <> @Value) then begin
fOnPutText := Value;
Change();
end;
@ -177,25 +168,25 @@ end;
procedure TKOLEcmListEdit.SetOnEndEdit(const Value: TOnEndEdit);
begin
if @fOnEndEdit <> @Value then begin
if (@fOnEndEdit <> @Value) then begin
fOnEndEdit := Value;
Change();
end;
end;
procedure TKOLEcmListEdit.SetOnColAdjust(const Value: TOnColAdjust);
procedure TKOLEcmListEdit.SetOnCellAdjust(const Value: TOnCellAdjust);
begin
if @fOnColAdjust <> @Value then begin
fOnColAdjust := Value;
if (@fOnCellAdjust <> @Value) then begin
fOnCellAdjust := Value;
Change;
end;
end;
procedure TKOLEcmListEdit.SetOnEditChar(const Value: TOnEditChar);
begin
if @fOnEditChar <> @Value then begin
if (@fOnEditChar <> @Value) then begin
fOnEditChar := Value;
Change();
Change;
end;
end;
@ -203,7 +194,7 @@ procedure TKOLEcmListEdit.SetOnDrawCell(const Value: TOnDrawCell);
begin
if @FOnDrawCell <> @Value then begin
FOnDrawCell:= Value;
Change();
Change;
end;
end;
@ -214,13 +205,12 @@ end;
procedure TKOLEcmListEdit.SetOnCreateEdit(const Value: TOnCreateEdit);
begin
if @fOnCreateEdit <> @Value then begin
if (@fOnCreateEdit <> @Value) then begin
fOnCreateEdit := Value;
Change();
Change;
end;
end;
procedure TKOLEcmListEdit.SetLimStyle(const Value: TKOLListViewStyle);
begin
if (Value <> fLimStyle) and ((Value = lvsDetail) or (Value = lvsDetailNoHeader)) then begin

4
Addons/mckXPMenus.pas
View File

@ -167,7 +167,7 @@ begin
MI.SetupTemplate( SL, I = 0, ParentKOLForm );
end;
S := ''''' ], ' + OnMenuItemMethodName(False) + ', false );';
S := ''''' ], ' + OnMenuItemMethodName() + ', false );';
if Count <> 0 then
S := ', ' + S;
if Length( S ) + Length( SL[ SL.Count - 1 ] ) > 64 then
@ -297,7 +297,7 @@ begin
MI.SetupTemplate( SL, I = 0, ParentKOLForm );
end;
S := ''''' ], ' + OnMenuItemMethodName(False) + ', true );';
S := ''''' ], ' + OnMenuItemMethodName() + ', true );';
if Count <> 0 then
S := ', ' + S;
if Length( S ) + Length( SL[ SL.Count - 1 ] ) > 64 then

6
Addons/tinyJPGGIFBMP.pas
View File

@ -43,7 +43,7 @@ procedure tinyLoadJPGGIFBMPFile(var TargetBitmap: PBitMap; FileName: String);
var
Stream: IStream;
Picta: IPicture;
hh: THandle;
hh: OLE_HANDLE;
asm
//[ebx] = PBitmap;
//edi = FileName;
@ -111,7 +111,7 @@ procedure tinyLoadJPGGIFBMPMemory(var TargetBitmap: PBitMap; Ptr: HGlobal; Size:
var
Stream: IStream;
Picta: IPicture;
hh: THandle;
hh: OLE_HANDLE;
begin
TargetBitmap := nil;
if CreateStreamOnHGlobal(ptr, TRUE, Stream) <> S_OK then
@ -142,7 +142,7 @@ end;
procedure tinyLoadJPGGIFBMPString(const s: String; out TargetBitmap: PBitMap);
var
hh: DWORD;
hh: OLE_HANDLE;
hPtr: DWORD;
len: Integer;
Stream: IStream;