paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 15:58:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Fix deprecation warnings. Issue #40918, patch by Don Siders.

Browse Source
This commit is contained in:
Juha 2024-04-22 08:03:50 +03:00
parent 308396194c
commit d784606f77
28 changed files with 207 additions and 207 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/comctrls.pp
View File

@ -35,7 +35,7 @@ uses
WSReferences, Graphics, ImgList, ActnList, Themes, Menus,
Controls, Forms, StdCtrls, ExtCtrls, ToolWin, Buttons,
// LazUtils
GraphType, LazUTF8, LazLoggerBase, LazUtilities, IntegerList;
GraphType, LazUTF8, LazLoggerBase, LazTracer, LazUtilities, IntegerList;
type
THitTest = (htAbove, htBelow, htNowhere, htOnItem, htOnButton, htOnIcon,

2
lcl/forms.pp
View File

@ -40,7 +40,7 @@ uses
ClipBrd, HelpIntfs, Controls, ImgList, Themes,
// LazUtils
LazFileUtils, LazUTF8, Maps, IntegerList, LazMethodList, LazLoggerBase,
LazUtilities, GraphType;
Laztracer, LazUtilities, GraphType;
type
TProcedure = procedure;

6
lcl/include/application.inc
View File

@ -129,7 +129,7 @@ var
HandlerType: TApplicationHandlerType;
begin
if Self=nil then
RaiseGDBException('TApplication.Destroy Self=nil');
LazTracer.RaiseGDBException('TApplication.Destroy Self=nil');
Include(FFlags,AppDestroying);
if Assigned(FOnDestroy) then FOnDestroy(Self);
@ -1514,7 +1514,7 @@ end;
procedure TApplication.AddHandler(HandlerType: TApplicationHandlerType;
const Handler: TMethod; AsFirst: Boolean);
begin
if Handler.Code=nil then RaiseGDBException('TApplication.AddHandler');
if Handler.Code=nil then LazTracer.RaiseGDBException('TApplication.AddHandler');
if FApplicationHandlers[HandlerType]=nil then
FApplicationHandlers[HandlerType]:=TMethodList.Create;
FApplicationHandlers[HandlerType].Add(Handler,not AsFirst);
@ -1651,7 +1651,7 @@ end;
procedure TApplication.EnableIdleHandler;
begin
if FIdleLockCount<=0 then
RaiseGDBException('TApplication.EnableIdleHandler');
LazTracer.RaiseGDBException('TApplication.EnableIdleHandler');
dec(FIdleLockCount);
end;

2
lcl/include/customcombobox.inc
View File

@ -72,7 +72,7 @@ procedure TCustomComboBox.DestroyWnd;
var
NewStrings: TStrings;
begin
if not HandleAllocated then RaiseGDBException('');
if not HandleAllocated then LazTracer.RaiseGDBException('');
// store itemindex
FItemIndex := TWSCustomComboBoxClass(WidgetSetClass).GetItemIndex(Self);
// create an internal list for storing items internally

2
lcl/include/customform.inc
View File

@ -833,7 +833,7 @@ end;
procedure TCustomForm.AddHandler(HandlerType: TFormHandlerType;
const Handler: TMethod; AsFirst: Boolean);
begin
if Handler.Code=nil then RaiseGDBException('TCustomForm.AddHandler');
if Handler.Code=nil then LazTracer.RaiseGDBException('TCustomForm.AddHandler');
if FFormHandlers[HandlerType]=nil then
FFormHandlers[HandlerType]:=TMethodList.Create;
FFormHandlers[HandlerType].Add(Handler,not AsFirst);

2
lcl/include/customlistview.inc
View File

@ -1277,7 +1277,7 @@ end;
procedure TCustomListView.EndUpdate;
begin
if FUpdateCount <= 0
then RaiseGDBException('TCustomListView.EndUpdate FUpdateCount=0');
then LazTracer.RaiseGDBException('TCustomListView.EndUpdate FUpdateCount=0');
Dec(FUpdateCount);
if FUpdateCount=0 then Exclude(FFlags, lffPreparingSorting);

4
lcl/include/menuitem.inc
View File

@ -132,7 +132,7 @@ procedure TMenuItem.CreateHandle;
begin
//DebugLn('TMenuItem.CreateHandle ',dbgsName(Self),' ',dbgs(Self));
//DebugLn('TMenuItem.CreateHandle START ',Name,':',ClassName);
if not FVisible then RaiseGDBException('');
if not FVisible then LazTracer.RaiseGDBException('');
FHandle := TWSMenuItemClass(WidgetSetClass).CreateHandle(Self);
CheckChildrenHandles;
@ -876,7 +876,7 @@ procedure TMenuItem.Insert(Index: Integer; Item: TMenuItem);
begin
if (Item = nil) then exit;
if Item.Parent <> nil then
RaiseGDBException('Menu inserted twice');
LazTracer.RaiseGDBException('Menu inserted twice');
// create Items if needed
if FItems = nil then FItems := TMenuItems.Create(Self);

8
lcl/include/screen.inc
View File

@ -152,7 +152,7 @@ begin
(csDestroying in ACustomForm.ComponentState) or
(FCustomForms.IndexOf(ACustomForm)<0)
then
RaiseGDBException('TScreen.MoveFormToFocusFront');
LazTracer.RaiseGDBException('TScreen.MoveFormToFocusFront');
if (FCustomForms.Count=0) or (TObject(FCustomForms[0])<>ACustomForm) then
begin
FCustomForms.Remove(ACustomForm);
@ -175,7 +175,7 @@ begin
(csDestroying in ACustomForm.ComponentState) or
(FCustomForms.IndexOf(ACustomForm)<0)
then
RaiseGDBException('TScreen.MoveFormToZFront');
LazTracer.RaiseGDBException('TScreen.MoveFormToZFront');
if (FCustomFormsZOrdered.Count = 0) or
(TObject(FCustomFormsZOrdered[0]) <> ACustomForm) then
@ -497,7 +497,7 @@ begin
for i := 0 to MonitorCount - 1 do
if Monitors[i].Handle = AHandle then
Exit(Monitors[i]);
RaiseGDBException(AErrorMsg); // internal error
LazTracer.RaiseGDBException(AErrorMsg); // internal error
end;
function TScreen.MonitorFromPoint(const Point: TPoint;
@ -1145,7 +1145,7 @@ procedure TScreen.AddHandler(HandlerType: TScreenNotification;
const Handler: TMethod; AsFirst: Boolean);
begin
if Handler.Code = nil then
RaiseGDBException('TScreen.AddHandler');
LazTracer.RaiseGDBException('TScreen.AddHandler');
if FScreenHandlers[HandlerType] = nil then
FScreenHandlers[HandlerType] := TMethodList.Create;
FScreenHandlers[HandlerType].Add(Handler, not AsFirst);

2
lcl/include/scrollbar.inc
View File

@ -48,7 +48,7 @@ var
ScrollInfo: TScrollInfo;
begin
inherited CreateWnd;
if not HandleAllocated then RaiseGDBException('TCustomScrollBar.CreateWnd HandleAllocated=false');
if not HandleAllocated then LazTracer.RaiseGDBException('TCustomScrollBar.CreateWnd HandleAllocated=false');
ScrollInfo.cbSize := SizeOf(ScrollInfo);
ScrollInfo.nMin := FMin;
ScrollInfo.nMax := FMax;

2
lcl/include/statusbar.inc
View File

@ -248,7 +248,7 @@ end;
procedure TStatusBar.EndUpdate;
begin
if FUpdateLock<=0 then RaiseGDBException('TStatusBar.EndUpdate');
if FUpdateLock<=0 then LazTracer.RaiseGDBException('TStatusBar.EndUpdate');
if FUpdateLock=1 then begin
// end update in Panels before decreasing FUpdateLock, so that
// multiple changes of Panels will be combined

2
lcl/include/tabcontrol.inc
View File

@ -112,7 +112,7 @@ end;
procedure TTabControlStrings.EndUpdate;
begin
if FUpdateCount=0 then
RaiseGDBException('TTabControlStrings.EndUpdate');
LazTracer.RaiseGDBException('TTabControlStrings.EndUpdate');
dec(FUpdateCount);
end;

112
lcl/include/treeview.inc
View File

@ -1438,7 +1438,7 @@ begin
// remove from parents list
OldIndex:=FIndex;
if OldIndex<0 then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
for i:=OldIndex to FParent.FCount-2 do begin
FParent.FItems[i]:=FParent.FItems[i+1];
FParent.FItems[i].FIndex:=i;
@ -2095,70 +2095,70 @@ var
Node1: TTreeNode;
begin
if FCapacity<0 then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if FCapacity<FCount then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if FCount<0 then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if FHeight<0 then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (FItems<>nil) and (FCapacity<=0) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (FCapacity>0) and (FItems=nil) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (FNextBrother<>nil) and (FNextBrother.FPrevBrother<>Self) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (FPrevBrother<>nil) and (FPrevBrother.FNextBrother<>Self) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (FNextMultiSelected<>nil) and (FNextMultiSelected.FPrevMultiSelected<>Self) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (FPrevMultiSelected<>nil) and (FPrevMultiSelected.FNextMultiSelected<>Self) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if MultiSelected then begin
Node1:=TreeView.GetFirstMultiSelected;
while (Node1<>nil) and (Node1<>Self) do Node1:=Node1.FNextMultiSelected;
if Node1=nil then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
end;
if Selected and (TreeView<>nil) and (tvoAllowMultiselect in TreeView.Options)
and (not MultiSelected) then
RaiseGDBException('');// selected, but not multiselected
LazTracer.RaiseGDBException('');// selected, but not multiselected
// check children
RealSubTreeCount:=1;
for i:=0 to FCount-1 do begin
if (Items[i]=nil) then RaiseGDBException('');
if (Items[i]=nil) then LazTracer.RaiseGDBException('');
Node1:=Items[i];
if Node1.FParent<>Self then RaiseGDBException('');
if Node1.FParent<>Self then LazTracer.RaiseGDBException('');
if (i=0) and (Node1.FPrevBrother<>nil) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (i>0) and (Node1.FPrevBrother=nil) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (i>0) and (Node1.FPrevBrother<>Items[i-1]) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (i<FCount-1) and (Node1.FNextBrother=nil) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (i<FCount-1) and (Node1.FNextBrother<>Items[i+1]) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (i=FCount-1) and (Node1.FNextBrother<>nil) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if Node1.FIndex<>i then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
Node1.ConsistencyCheck;
inc(RealSubTreeCount,Node1.SubTreeCount);
end;
if FParent<>nil then begin
if FParent.IndexOf(Self)<0 then RaiseGDBException('');
if FParent.IndexOf(Self)<0 then LazTracer.RaiseGDBException('');
end;
if RealSubTreeCount<>SubTreeCount then RaiseGDBException('');
if FTop<0 then RaiseGDBException('');
if RealSubTreeCount<>SubTreeCount then LazTracer.RaiseGDBException('');
if FTop<0 then LazTracer.RaiseGDBException('');
// check for circles
if FNextBrother=Self then RaiseGDBException('');
if FPrevBrother=Self then RaiseGDBException('');
if FParent=Self then RaiseGDBException('');
if FNextBrother=Self then LazTracer.RaiseGDBException('');
if FPrevBrother=Self then LazTracer.RaiseGDBException('');
if FParent=Self then LazTracer.RaiseGDBException('');
Node1:=FParent;
while Node1<>nil do begin
if (Node1=Self) then RaiseGDBException('');
if (Node1=Self) then LazTracer.RaiseGDBException('');
Node1:=Node1.FParent;
end;
end;
@ -3135,7 +3135,7 @@ var
OldCache: TNodeCache;
begin
if FUpdateCount<0 then
RaiseGDBException('FUpdateCount<0');
LazTracer.RaiseGDBException('FUpdateCount<0');
RealCount:=0;
Node:=GetFirstNode;
while Node<>nil do begin
@ -3146,37 +3146,37 @@ begin
end;
//DebugLn(' ConsistencyCheck: B ',RealCount,',',FCount);
if RealCount<>FCount then
RaiseGDBException('RealCount<>FCount');
LazTracer.RaiseGDBException('RealCount<>FCount');
if (FTopLvlCapacity<=0) and (FTopLvlItems<>nil) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (FTopLvlCapacity>0) and (FTopLvlItems=nil) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if FTopLvlCapacity<FTopLvlCount then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (FTopLvlCount<0) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
for i:=0 to FTopLvlCount-1 do begin
Node:=FTopLvlItems[i];
if (i=0) and (Node.FPrevBrother<>nil) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (i>0) and (Node.FPrevBrother<>FTopLvlItems[i-1]) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (i<FTopLvlCount-1) and (Node.FNextBrother<>FTopLvlItems[i+1])
then begin
DebugLn(' CONSISTENCY i=%d FTopLvlCount=%d FTopLvlItems[i]=%p FTopLvlItems[i].FNextBrother=%p FTopLvlItems[i+1]=%p',
[i, FTopLvlCount, Pointer(Node), Pointer(Node.FNextBrother), Pointer(FTopLvlItems[i+1])]);
RaiseGDBException('');
LazTracer.RaiseGDBException('');
end;
if (i=FTopLvlCount-1) and (Node.FNextBrother<>nil) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if Node.FIndex<>i then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
end;
if FNodeCache.CacheNode<>nil then begin
OldCache:=FNodeCache;
ClearCache;
if GetNodeFromIndex(OldCache.CacheIndex)<>OldCache.CacheNode then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
end;
end;
@ -3612,7 +3612,7 @@ end;
procedure TCustomTreeView.EndUpdate;
begin
UnlockSelectionChangeEvent;
if Items.FUpdateCount<=0 then RaiseGDBException('TCustomTreeView.EndUpdate');
if Items.FUpdateCount<=0 then LazTracer.RaiseGDBException('TCustomTreeView.EndUpdate');
Items.EndUpdate;
if Items.FUpdateCount=0 then begin
// ToDo: only refresh if something changed
@ -6600,25 +6600,25 @@ var OldMaxRight, OldLastTop, OldMaxLvl: integer;
OldTopItem, OldBottomItem: TTreeNode;
begin
if Canvas=nil then
RaiseGDBException('Canvas=nil');
LazTracer.RaiseGDBException('Canvas=nil');
if FDefItemHeight<0 then
RaiseGDBException('FDefItemHeight='+IntToStr(FDefItemHeight));
LazTracer.RaiseGDBException('FDefItemHeight='+IntToStr(FDefItemHeight));
if FIndent<0 then
RaiseGDBException('FIndent='+IntToStr(FIndent));
LazTracer.RaiseGDBException('FIndent='+IntToStr(FIndent));
if FMaxRight<0 then
RaiseGDBException('FMaxRight='+IntToStr(FMaxRight));
LazTracer.RaiseGDBException('FMaxRight='+IntToStr(FMaxRight));
if FTreeNodes=nil then
RaiseGDBException('FTreeNodes=nil');
LazTracer.RaiseGDBException('FTreeNodes=nil');
FTreeNodes.ConsistencyCheck;
if Items.FUpdateCount<0 then
RaiseGDBException('FUpdateCount='+IntToStr(Items.FUpdateCount));
LazTracer.RaiseGDBException('FUpdateCount='+IntToStr(Items.FUpdateCount));
if (not (tvsTopsNeedsUpdate in FStates)) then begin
if Items.GetLastSubNode<>nil then begin
OldLastTop:=Items.GetLastSubNode.Top;
Include(FStates,tvsTopsNeedsUpdate);
UpdateAllTops;
if OldLastTop<>Items.GetLastSubNode.Top then
RaiseGDBException('OldLastTop='+DbgS(OldLastTop)
LazTracer.RaiseGDBException('OldLastTop='+DbgS(OldLastTop)
+'<>Items.GetLastSubNode.Top='+DbgS(Items.GetLastSubNode.Top));
end;
end;
@ -6627,32 +6627,32 @@ begin
Include(FStates,tvsMaxRightNeedsUpdate);
UpdateMaxRight;
if OldMaxRight<>FMaxRight then
RaiseGDBException('OldMaxRight<>FMaxRight');
LazTracer.RaiseGDBException('OldMaxRight<>FMaxRight');
end;
if not (tvsMaxLvlNeedsUpdate in FStates) then begin
OldMaxLvl:=FMaxLvl;
Include(FStates,tvsMaxLvlNeedsUpdate);
UpdateMaxLvl;
if OldMaxLvl<>FMaxLvl then
RaiseGDBException('OldMaxLvl<>FMaxLvl');
LazTracer.RaiseGDBException('OldMaxLvl<>FMaxLvl');
end;
if (tvsIsEditing in FStates) and (FSelectedNode=nil) then
RaiseGDBException('');
LazTracer.RaiseGDBException('');
if (FSelectedNode<>nil) then begin
if not FSelectedNode.IsVisible then
RaiseGDBException('not FSelectedNode.IsVisible');
LazTracer.RaiseGDBException('not FSelectedNode.IsVisible');
end;
if not (tvsTopItemNeedsUpdate in FStates) then begin
OldTopItem:=FTopItem;
UpdateTopItem;
if FTopItem<>OldTopItem then
RaiseGDBException('FTopItem<>OldTopItem');
LazTracer.RaiseGDBException('FTopItem<>OldTopItem');
end;
if not (tvsBottomItemNeedsUpdate in FStates) then begin
OldBottomItem:=FBottomItem;
UpdateBottomItem;
if FBottomItem<>OldBottomItem then
RaiseGDBException('FBottomItem<>OldBottomItem');
LazTracer.RaiseGDBException('FBottomItem<>OldBottomItem');
end;
end;
@ -6675,7 +6675,7 @@ procedure TCustomTreeView.UnlockSelectionChangeEvent;
begin
dec(FSelectionChangeEventLock);
if FSelectionChangeEventLock<0 then
RaiseGDBException('TCustomTreeView.UnlockSelectionChangeEvent');
LazTracer.RaiseGDBException('TCustomTreeView.UnlockSelectionChangeEvent');
if (FSelectionChangeEventLock=0) and (tvsSelectionChanged in FStates) then
InternalSelectionChanged;
end;

2
lcl/interfaces/win32/win32int.pp
View File

@ -37,7 +37,7 @@ uses
Controls, Buttons, Forms, Dialogs, StdCtrls,
Graphics, Menus, ComCtrls, Themes, Win32Def, Spin,
// LazUtils
GraphType, GraphMath, LazUTF8, Translations;
GraphType, GraphMath, LazLoggerBase, LazUTF8, Translations;
{, Win32Debug}
const

4
lcl/interfaces/win32/win32lclintf.inc
View File

@ -844,7 +844,7 @@ var
if ABitmap = 0
then begin
DebugLn('Windows.CreateDIBSection returns 0. Reason = ' + GetLastErrorText(Windows.GetLastError));
LazLoggerBase.DebugLn('Windows.CreateDIBSection returns 0. Reason = ' + GetLastErrorText(Windows.GetLastError));
Exit(False);
end;
if DstLinePtr = nil then Exit(False);
@ -926,7 +926,7 @@ begin
AMask := Windows.CreateBitmap(ADesc.Width, ADesc.Height, 1, 1, ARawImage.Mask);
if AMask = 0 then
DebugLn('Windows.CreateBitmap returns 0. Reason = ' + GetLastErrorText(Windows.GetLastError));
LazLoggerBase.DebugLn('Windows.CreateBitmap returns 0. Reason = ' + GetLastErrorText(Windows.GetLastError));
Result := AMask <> 0;
//DbgDumpBitmap(AMask, 'CreateBitmaps - Mask');
end;

6
lcl/interfaces/win32/win32object.inc
View File

@ -60,7 +60,7 @@ begin
n := FTimerData.Count;
if (n > 0) then
begin
DebugLn(Format('[TWin32WidgetSet.Destroy] WARNING: There are %d TimerInfo structures left, I''ll free them' ,[n]));
LazLoggerBase.DebugLn(Format('[TWin32WidgetSet.Destroy] WARNING: There are %d TimerInfo structures left, I''ll free them' ,[n]));
while (n > 0) do
begin
dec(n);
@ -120,7 +120,7 @@ begin
Done := True;
if not WinRegister then
begin
DebugLn('Trace:Win32Object.Init - Register Failed');
LazLoggerBase.DebugLn('Trace:Win32Object.Init - Register Failed');
Exit;
end;
@ -430,7 +430,7 @@ begin
end else
if retVal = $FFFFFFFF then
begin
DebugLn('[TWin32WidgetSet.AppProcessMessages] MsgWaitForMultipleObjects returned: ', IntToStr(GetLastError));
LazLoggerBase.DebugLn('[TWin32WidgetSet.AppProcessMessages] MsgWaitForMultipleObjects returned: ', IntToStr(GetLastError));
break;
end;
until false;

4
lcl/interfaces/win32/win32proc.pp
View File

@ -23,7 +23,7 @@ interface
uses
Windows, Win32Extra, Classes, SysUtils,
LMessages, LCLType, LCLProc, LCLMessageGlue, LazUTF8, Controls, Forms, Menus,
LMessages, LCLType, LCLProc, LCLMessageGlue, LazUTF8, LazLoggerBase, Controls, Forms, Menus,
GraphType, IntfGraphics, Themes;
const
@ -1165,7 +1165,7 @@ end;
function GetBitmapOrder(AWinBmp: Windows.TBitmap; ABitmap: HBITMAP): TRawImageLineOrder;
procedure DbgLog(const AFunc: String);
begin
DebugLn('GetBitmapOrder - GetDIBits ', AFunc, ' failed: ', GetLastErrorText(Windows.GetLastError));
LazLoggerBase.DebugLn('GetBitmapOrder - GetDIBits ', AFunc, ' failed: ', GetLastErrorText(Windows.GetLastError));
end;
var

9
lcl/interfaces/win32/win32winapi.inc
View File

@ -554,7 +554,8 @@ function TWin32WidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
begin
DataHandle := Windows.GlobalAlloc(Windows.GMEM_MOVEABLE, SourceStream.Size);
if (DataHandle=HWND(0)) then begin
debugln('TWin32WidgetSet.ClipboardGetOwnerShip DataHandle=',dbgs(DataHandle),' DataSize=',dbgs(SourceStream.Size));
LazLoggerBase.debugln('TWin32WidgetSet.ClipboardGetOwnerShip DataHandle=',
LazLoggerBase.dbgs(DataHandle),' DataSize=',LazLoggerBase.dbgs(SourceStream.Size));
Result := false;
exit;
end;
@ -689,7 +690,7 @@ begin
end;
try
if not Windows.EmptyClipboard then begin
debugln('TWin32WidgetSet.ClipboardGetOwnerShip A EmptyClipboard failed');
LazLoggerBase.debugln('TWin32WidgetSet.ClipboardGetOwnerShip A EmptyClipboard failed');
exit;
end;
Result := true;
@ -702,7 +703,7 @@ begin
end;
finally
if not Windows.CloseClipboard then begin
debugln('TWin32WidgetSet.ClipboardGetOwnerShip A CloseClipboard failed');
LazLoggerBase.debugln('TWin32WidgetSet.ClipboardGetOwnerShip A CloseClipboard failed');
end;
end;
end;
@ -1441,7 +1442,7 @@ begin
// Note Michl: When style PS_USERSTYLE is used, lpStyle can't be nil, there
// must be dwSytleCount >= 1, see issue #30661
if Result = 0 then
DebugLn('TWin32WidgetSet.ExtCreatePen returns 0. Reason = ' + GetLastErrorText(Windows.GetLastError));
LazLoggerBase.DebugLn('TWin32WidgetSet.ExtCreatePen returns 0. Reason = ' + GetLastErrorText(Windows.GetLastError));
end;
function IsCharSurrogateHigh(ch: WideChar): Boolean; inline;

4
lcl/interfaces/win32/win32wscomctrls.pp
View File

@ -27,7 +27,7 @@ uses
// LCL
ComCtrls, LCLType, Controls, Graphics, Themes,
ImgList, StdCtrls, Forms, LCLIntf, LCLProc,
LMessages, LazUTF8, LCLMessageGlue, InterfaceBase,
LMessages, LazUTF8, LCLMessageGlue, InterfaceBase, LazLoggerBase,
// widgetset
WSComCtrls, WSLCLClasses, WSControls, WSProc,
// win32 widgetset
@ -318,7 +318,7 @@ begin
if PreferredSizeStatusBar = 0 then
begin
AErrorCode := GetLastError;
DebugLn(['Failed to create win32 control, error: ', AErrorCode, ' : ', GetLastErrorText(AErrorCode)]);
LazLoggerBase.DebugLn(['Failed to create win32 control, error: ', AErrorCode, ' : ', GetLastErrorText(AErrorCode)]);
raise Exception.Create('Failed to create win32 control, error: ' + IntToStr(AErrorCode) + ' : ' + GetLastErrorText(AErrorCode));
end;
GetWindowRect(PreferredSizeStatusBar, R);

4
lcl/interfaces/win32/win32wscontrols.pp
View File

@ -32,7 +32,7 @@ uses
////////////////////////////////////////////////////
WSControls, WSLCLClasses, SysUtils, Win32Proc, Win32Extra, WSProc,
{ LCL }
InterfaceBase, LCLType, LCLIntf, LCLProc, LazUTF8, Themes, Forms;
InterfaceBase, LCLType, LCLIntf, LCLProc, LazUTF8, LazLoggerBase, Themes, Forms;
type
{ TWin32WSDragImageListResolution }
@ -223,7 +223,7 @@ begin
if Window = 0 then
begin
AErrorCode := GetLastError;
DebugLn(['Failed to create win32 control, error: ', AErrorCode, ' : ', GetLastErrorText(AErrorCode)]);
LazLoggerBase.DebugLn(['Failed to create win32 control, error: ', AErrorCode, ' : ', GetLastErrorText(AErrorCode)]);
raise Exception.Create('Failed to create win32 control, error: ' + IntToStr(AErrorCode) + ' : ' + GetLastErrorText(AErrorCode));
end;
end;

2
lcl/interfaces/win32/win32wscustomlistview.inc
View File

@ -326,7 +326,7 @@ var
var
DataHintInfo: PNMLVCACHEHINT;
begin
debugln('HandleListViewOwnerDataHint');
LazLoggerBase.debugln('HandleListViewOwnerDataHint');
DataHintInfo := PNMLVCACHEHINT(LPARAM);
if not Assigned(DataHintInfo) or (not ALV.OwnerData) then
Exit;

10
lcl/interfaces/win32/win32wsmenus.pp
View File

@ -33,7 +33,7 @@ uses
WSMenus, WSLCLClasses, WSProc,
Windows, Controls, Classes, SysUtils, Win32Int, Win32Proc, Win32WSImgList,
LCLProc, Themes, UxTheme, Win32Themes, Win32Extra,
FileUtil, LazUTF8;
FileUtil, LazUTF8, LazLoggerBase, LazTracer;
type
@ -1509,14 +1509,14 @@ begin
MenuInfo.hSubmenu := ParentMenuHandle;
CallMenuRes := SetMenuItemInfoW(ParentOfParent, AMenuItem.MergedParent.Command, False, @MenuInfo);
if not CallMenuRes then
DebugLn(['SetMenuItemInfo failed: ', GetLastErrorReport]);
LazLoggerBase.DebugLn(['SetMenuItemInfo failed: ', GetLastErrorReport]);
end;
end;
end;
ItemIndex := AMenuItem.MergedParent.VisibleIndexOf(AMenuItem);
if ItemIndex<0 then
RaiseGDBException('Invisible menu item: '+AMenuItem.Name+' ('+AMenuItem.Caption+')');
LazTracer.RaiseGDBException('Invisible menu item: '+AMenuItem.Name+' ('+AMenuItem.Caption+')');
// MDI forms with a maximized MDI child insert a menu at the first index for
// the MDI child's window menu, so we need to take that into account
if Assigned(Application.MainForm) and
@ -1571,7 +1571,7 @@ begin
end;
CallMenuRes := InsertMenuItemW(ParentMenuHandle, ItemIndex, True, @MenuInfo);
if not CallMenuRes then
DebugLn(['InsertMenuItem failed with error: ', GetLastErrorReport]);
LazLoggerBase.DebugLn(['InsertMenuItem failed with error: ', GetLastErrorReport]);
TriggerFormUpdate(AMenuItem);
end;
@ -1608,7 +1608,7 @@ begin
MenuInfo.hSubmenu := 0;
CallMenuRes := SetMenuItemInfoW(ParentOfParentHandle, AMenuItem.MergedParent.Command, False, @MenuInfo);
if not CallMenuRes then
DebugLn(['SetMenuItemInfo failed: ', GetLastErrorReport]);
LazLoggerBase.DebugLn(['SetMenuItemInfo failed: ', GetLastErrorReport]);
// Set menu item info destroys/corrupts our internal popup menu for the
// unknown reason. We need to recreate it.
if not IsMenu(ParentHandle) then

136
lcl/lclproc.pas
View File

@ -187,33 +187,33 @@ procedure DebugLnExit (const s1, s2: string; const s3: string = '';
procedure CloseDebugOutput; deprecated 'Use DebugLogger.Finish instead';
function DbgS(const c: cardinal): string; overload; deprecated 'Use DebugLogger.Dbgs instead';
function DbgS(const i: longint): string; overload; deprecated 'Use DebugLogger.Dbgs instead';
function DbgS(const i: int64): string; overload; deprecated 'Use DebugLogger.Dbgs instead';
function DbgS(const q: qword): string; overload; deprecated 'Use DebugLogger.Dbgs instead';
function DbgS(const r: TRect): string; overload; deprecated 'Use DebugLogger.Dbgs instead';
function DbgS(const p: TPoint): string; overload; deprecated 'Use DebugLogger.Dbgs instead';
function DbgS(const p: pointer): string; overload; deprecated 'Use DebugLogger.Dbgs instead';
function DbgS(const e: extended; MaxDecimals: integer = 999): string; overload; deprecated 'Use DebugLogger.Dbgs instead';
function DbgS(const b: boolean): string; overload; deprecated 'Use DebugLogger.Dbgs instead';
function DbgS(const s: TComponentState): string; overload; deprecated 'Use DebugLogger.Dbgs instead';
function DbgS(const m: TMethod): string; overload; deprecated 'Use DebugLogger.Dbgs instead';
function DbgSName(const p: TObject): string; overload; deprecated 'Use DebugLogger.DbgSName instead';
function DbgSName(const p: TClass): string; overload; deprecated 'Use DebugLogger.DbgSName instead';
function DbgS(const c: cardinal): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const i: longint): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const i: int64): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const q: qword): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const r: TRect): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const p: TPoint): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const p: pointer): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const e: extended; MaxDecimals: integer = 999): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const b: boolean): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const s: TComponentState): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const m: TMethod): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgSName(const p: TObject): string; overload; deprecated 'Use LazLoggerBase.DbgSName instead';
function DbgSName(const p: TClass): string; overload; deprecated 'Use LazLoggerBase.DbgSName instead';
function DbgStr(const StringWithSpecialChars: string): string; overload;
deprecated 'Use DebugLogger.DbgStr instead';
deprecated 'Use LazLoggerBase.DbgStr instead';
function DbgWideStr(const StringWithSpecialChars: widestring): string; overload;
deprecated 'Use DebugLogger.DbgWideStr instead';
deprecated 'Use LazLoggerBase.DbgWideStr instead';
function dbgMemRange(P: PByte; Count: integer; Width: integer = 0): string; overload;
deprecated 'Use DebugLogger.dbgMemRange instead';
deprecated 'Use LazLoggerBase.dbgMemRange instead';
function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string; overload;
deprecated 'Use DebugLogger.dbgMemStream instead';
function dbgObjMem(AnObject: TObject): string; overload; deprecated 'Use DebugLogger.dbgObjMem instead';
function dbgHex(i: Int64): string; overload; deprecated 'Use DebugLogger.dbgHex instead';
function DbgS(const i1,i2,i3,i4: integer): string; overload; deprecated 'Use DebugLogger.Dbgs instead';
function DbgS(const Shift: TShiftState): string; overload; deprecated 'Use DebugLogger.Dbgs instead';
function DbgS(const ASize: TSize): string; overload; deprecated 'Use DebugLogger.Dbgs instead';
deprecated 'Use LazLoggerBase.dbgMemStream instead';
function dbgObjMem(AnObject: TObject): string; overload; deprecated 'Use LazLoggerBase.dbgObjMem instead';
function dbgHex(i: Int64): string; overload; deprecated 'Use LazLoggerBase.dbgHex instead';
function DbgS(const i1,i2,i3,i4: integer): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const Shift: TShiftState): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const ASize: TSize): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgSWindowPosFlags(Flags: UInt): String;
function DbgsVKCode(c: word): string;
@ -1382,7 +1382,7 @@ begin
VK_LCL_ENDCALL: Result:='VK_LCL_ENDCALL';
VK_LCL_AT: Result:='VK_LCL_AT';
else
Result:='VK_('+dbgs(c)+')';
Result:='VK_('+LazLoggerBase.dbgs(c)+')';
end;
end;
@ -1390,26 +1390,26 @@ function DbgS(const ATM: TTextMetric): string;
begin
with ATM do
Result :=
'tmHeight: ' + DbgS(tmHeight) +
' tmAscent: ' + DbgS(tmAscent) +
' tmDescent: ' + DbgS(tmDescent) +
' tmInternalLeading: ' + DbgS(tmInternalLeading) +
' tmExternalLeading: ' + DbgS(tmExternalLeading) +
' tmAveCharWidth: ' + DbgS(tmAveCharWidth) +
' tmMaxCharWidth: ' + DbgS(tmMaxCharWidth) +
' tmWeight: ' + DbgS(tmWeight) +
' tmOverhang: ' + DbgS(tmOverhang) +
' tmDigitizedAspectX: ' + DbgS(tmDigitizedAspectX) +
' tmDigitizedAspectY: ' + DbgS(tmDigitizedAspectY) +
'tmHeight: ' + LazLoggerBase.DbgS(tmHeight) +
' tmAscent: ' + LazLoggerBase.DbgS(tmAscent) +
' tmDescent: ' + LazLoggerBase.DbgS(tmDescent) +
' tmInternalLeading: ' + LazLoggerBase.DbgS(tmInternalLeading) +
' tmExternalLeading: ' + LazLoggerBase.DbgS(tmExternalLeading) +
' tmAveCharWidth: ' + LazLoggerBase.DbgS(tmAveCharWidth) +
' tmMaxCharWidth: ' + LazLoggerBase.DbgS(tmMaxCharWidth) +
' tmWeight: ' + LazLoggerBase.DbgS(tmWeight) +
' tmOverhang: ' + LazLoggerBase.DbgS(tmOverhang) +
' tmDigitizedAspectX: ' + LazLoggerBase.DbgS(tmDigitizedAspectX) +
' tmDigitizedAspectY: ' + LazLoggerBase.DbgS(tmDigitizedAspectY) +
' tmFirstChar: ' + tmFirstChar +
' tmLastChar: ' + tmLastChar +
' tmDefaultChar: ' + tmDefaultChar +
' tmBreakChar: ' + tmBreakChar +
' tmItalic: ' + DbgS(tmItalic) +
' tmUnderlined: ' + DbgS(tmUnderlined) +
' tmStruckOut: ' + DbgS(tmStruckOut) +
' tmPitchAndFamily: ' + DbgS(tmPitchAndFamily) +
' tmCharSet: ' + DbgS(tmCharSet);
' tmItalic: ' + LazLoggerBase.DbgS(tmItalic) +
' tmUnderlined: ' + LazLoggerBase.DbgS(tmUnderlined) +
' tmStruckOut: ' + LazLoggerBase.DbgS(tmStruckOut) +
' tmPitchAndFamily: ' + LazLoggerBase.DbgS(tmPitchAndFamily) +
' tmCharSet: ' + LazLoggerBase.DbgS(tmCharSet);
end;
function DbgS(const AScrollInfo: TScrollInfo): string;
@ -1417,14 +1417,14 @@ begin
Result := '';
if (SIF_POS and AScrollInfo.fMask) > 0 then
Result := 'Pos: ' + DbgS(AScrollInfo.nPos);
Result := 'Pos: ' + LazLoggerBase.DbgS(AScrollInfo.nPos);
if (SIF_RANGE and AScrollInfo.fMask) > 0 then
Result := Result + ' Min: ' + DbgS(AScrollInfo.nMin) + ' Max: ' +
DbgS(AScrollInfo.nMax);
Result := Result + ' Min: ' + LazLoggerBase.DbgS(AScrollInfo.nMin) +
' Max: ' + LazLoggerBase.DbgS(AScrollInfo.nMax);
if (SIF_PAGE and AScrollInfo.fMask) > 0 then
Result := Result + ' Page: ' + DbgS(AScrollInfo.nPage);
Result := Result + ' Page: ' + LazLoggerBase.DbgS(AScrollInfo.nPage);
if (SIF_TRACKPOS and AScrollInfo.fMask) > 0 then
Result := Result + ' TrackPos: ' + DbgS(AScrollInfo.nTrackPos);
Result := Result + ' TrackPos: ' + LazLoggerBase.DbgS(AScrollInfo.nTrackPos);
if Result = '' then Result := '(no scrollinfo)';
end;
@ -1473,18 +1473,18 @@ begin
s:='';
for i:=Low(Args) to High(Args) do begin
case Args[i].VType of
vtInteger: s:=s+dbgs(Args[i].vinteger);
vtInt64: s:=s+dbgs(Args[i].VInt64^);
vtQWord: s:=s+dbgs(Args[i].VQWord^);
vtBoolean: s:=s+dbgs(Args[i].vboolean);
vtExtended: s:=s+dbgs(Args[i].VExtended^);
vtInteger: s:=s+LazLoggerBase.dbgs(Args[i].vinteger);
vtInt64: s:=s+LazLoggerBase.dbgs(Args[i].VInt64^);
vtQWord: s:=s+LazLoggerBase.dbgs(Args[i].VQWord^);
vtBoolean: s:=s+LazLoggerBase.dbgs(Args[i].vboolean);
vtExtended: s:=s+LazLoggerBase.dbgs(Args[i].VExtended^);
{$ifdef FPC_CURRENCY_IS_INT64}
// MWE:
// ppcppc 2.0.2 has troubles in choosing the right dbgs()
// so we convert here (i don't know about other versions
vtCurrency: s:=s+dbgs(int64(Args[i].vCurrency^)/10000, 4);
vtCurrency: s:=s+LazLoggerBase.dbgs(int64(Args[i].vCurrency^)/10000, 4);
{$else}
vtCurrency: s:=s+dbgs(Args[i].vCurrency^);
vtCurrency: s:=s+LazLoggerBase.dbgs(Args[i].vCurrency^);
{$endif}
vtString: s:=s+Args[i].VString^;
vtAnsiString: s:=s+AnsiString(Args[i].VAnsiString);
@ -1494,9 +1494,9 @@ begin
vtWideChar: s:=AnsiString(WideString(s)+Args[i].VWideChar);
vtWidestring: s:=AnsiString(WideString(s)+WideString(Args[i].VWideString));
vtUnicodeString: s:=AnsiString(UnicodeString(s)+UnicodeString(Args[i].VUnicodeString));
vtObject: s:=s+DbgSName(Args[i].VObject);
vtClass: s:=s+DbgSName(Args[i].VClass);
vtPointer: s:=s+Dbgs(Args[i].VPointer);
vtObject: s:=s+LazLoggerBase.DbgSName(Args[i].VObject);
vtClass: s:=s+LazLoggerBase.DbgSName(Args[i].VClass);
vtPointer: s:=s+LazLoggerBase.Dbgs(Args[i].VPointer);
else
DbgOutThreadLog('?unknown variant?');
end;
@ -1683,18 +1683,18 @@ var
procedure RaiseNotCreated;
begin
DebugLn('TDebugLCLItems.MarkDestroyed not created: p=',dbgs(p));
LazLoggerBase.DebugLn('TDebugLCLItems.MarkDestroyed not created: p=',LazLoggerBase.dbgs(p));
DumpStack;
RaiseGDBException('TDebugLCLItems.MarkDestroyed');
LazTracer.RaiseGDBException('TDebugLCLItems.MarkDestroyed');
end;
procedure RaiseDoubleDestroyed;
begin
debugLn('TDebugLCLItems.MarkDestroyed Double destroyed:');
debugln(Info.AsString(true));
debugln('Now:');
DebugLn(GetStackTrace(true));
RaiseGDBException('RaiseDoubleDestroyed');
LazLoggerBase.debugLn('TDebugLCLItems.MarkDestroyed Double destroyed:');
LazLoggerBase.debugln(Info.AsString(true));
LazLoggerBase.debugln('Now:');
LazLoggerBase.DebugLn(GetStackTrace(true));
LazTracer.RaiseGDBException('RaiseDoubleDestroyed');
end;
begin
@ -1726,11 +1726,11 @@ var
procedure RaiseDoubleCreated;
begin
debugLn('TDebugLCLItems.MarkCreated CREATED TWICE. Old:');
debugln(Info.AsString(true));
debugln(' New=',dbgs(p),' InfoText="',InfoText,'"');
DebugLn(GetStackTrace(true));
RaiseGDBException('RaiseDoubleCreated');
LazLoggerBase.debugLn('TDebugLCLItems.MarkCreated CREATED TWICE. Old:');
LazLoggerBase.debugln(Info.AsString(true));
LazLoggerBase.debugln(' New=',LazLoggerBase.dbgs(p),' InfoText="',InfoText,'"');
LazLoggerBase.DebugLn(GetStackTrace(true));
LazTracer.RaiseGDBException('RaiseDoubleCreated');
end;
begin
@ -1755,8 +1755,8 @@ end;
function TDebugLCLItemInfo.AsString(WithStackTraces: boolean): string;
begin
Result:='Item='+Dbgs(Item)+LineEnding
+'Info="'+DbgStr(Info)+LineEnding;
Result:='Item='+LazLoggerBase.Dbgs(Item)+LineEnding
+'Info="'+LazLoggerBase.DbgStr(Info)+LineEnding;
if WithStackTraces then
Result:=Result+'Creation:'+LineEnding+StackTraceAsString(CreationStack,true);
if IsDestroyed then begin

2
lcl/menus.pp
View File

@ -43,7 +43,7 @@ uses
LCLStrConsts, LCLType, LCLProc, LCLIntf, LCLClasses, LResources, LMessages,
ActnList, Graphics, ImgList, Themes,
// LazUtils
LazMethodList, LazLoggerBase;
LazMethodList, LazLoggerBase, LazTracer;
type
TMenu = class;

2
lcl/printers.pas
View File

@ -978,7 +978,7 @@ end;
procedure TPrinter.DoSetBinName(aName: string);
begin
if SupportedBins.Count>0 then
DebugLn('Warning: bin %s is not allowed',[aName]);
LazLoggerBase.DebugLn('Warning: bin %s is not allowed',[aName]);
end;
//Initialise aPaperRc with the aName paper rect

2
lcl/stdctrls.pp
View File

@ -30,7 +30,7 @@ uses
LCLStrConsts, LCLType, LCLProc, LCLIntf, LMessages, LResources, Graphics,
ActnList, Controls, Forms, Menus, Themes,
// LazUtils
TextStrings, ExtendedStrings, LazUTF8, LazMethodList, LazLoggerBase, LazUtilities;
TextStrings, ExtendedStrings, LazUTF8, LazMethodList, LazLoggerBase, LazTracer, LazUtilities;
type

66
lcl/taskdlgemulation.pp
View File

@ -46,8 +46,8 @@ uses
Classes, SysUtils,
LazUTF8,
LCLType, LCLStrConsts, LCLIntf, LMessages, InterfaceBase, ImgList, LCLProc, DateUtils, Math, ComCtrls,
LResources, Menus, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Buttons, Dialogs, DialogRes;
LResources, Menus, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Buttons, Dialogs, DialogRes,
LazLoggerBase;
type
@ -1269,9 +1269,9 @@ begin
// wParam: TRUE turns on marquee mode, FALSE turns off marquee mode.
// lParam: Must be zero.
// The return value is ignored
debugln(['TLCLTaskDialog.SetProgressBarType']);
debugln([' Msg.wParam=',Msg.wParam]);
debugln([' Msg.lParam=',Msg.lParam]);
LazLoggerBase.debugln(['TLCLTaskDialog.SetProgressBarType']);
LazLoggerBase.debugln([' Msg.wParam=',Msg.wParam]);
LazLoggerBase.debugln([' Msg.lParam=',Msg.lParam]);
//if both tfShowMarqueeProgressBar and tfShowProgressBar are set, user can switch ProgressBar.Style
if Assigned(ProgressBar) and (Msg.lParam = 0) then
begin
@ -1279,7 +1279,7 @@ begin
begin
if (tfShowMarqueeProgressBar in FDlg.Flags) then
begin
Debugln('TLCLTaskDialog.SetProgressBarType: set pbstMarquee');
LazLoggerBase.Debugln('TLCLTaskDialog.SetProgressBarType: set pbstMarquee');
ProgressBar.Style := pbstMarquee;
end;
end
@ -1287,7 +1287,7 @@ begin
begin
if (tfShowProgressBar in FDlg.Flags) then
begin
Debugln('TLCLTaskDialog.SetProgressBarType: set pbstNormal');
LazLoggerBase.Debugln('TLCLTaskDialog.SetProgressBarType: set pbstNormal');
ProgressBar.Style := pbstNormal;
end;
end;
@ -1301,10 +1301,10 @@ begin
// wParam: must be zero
// lParam: The LOWORD specifies the minimum value. The HIWORD specifies the maximum value.
// Returns the previous range if sucessfull, zero otherwise
debugln(['TLCLTaskDialog.SetProgressBarRange']);
debugln([' Msg.wParam=',Msg.wParam]);
debugln([' Msg.lParam LoWord=',LParamLoWord(Msg.lParam)]);
debugln([' Msg.lParam HiWord=',LParamHiWord(Msg.lParam)]);
LazLoggerBase.debugln(['TLCLTaskDialog.SetProgressBarRange']);
LazLoggerBase.debugln([' Msg.wParam=',Msg.wParam]);
LazLoggerBase.debugln([' Msg.lParam LoWord=',LParamLoWord(Msg.lParam)]);
LazLoggerBase.debugln([' Msg.lParam HiWord=',LParamHiWord(Msg.lParam)]);
if Assigned(ProgressBar) and (Msg.wParam = 0) then
begin
OldMin := ProgressBar.Min;
@ -1324,9 +1324,9 @@ begin
// wParam: An int that specifies the new position.
// lParam: Must be zero
// Returns the previous position
debugln(['TLCLTaskDialog.SetProgressBarPos']);
debugln([' Msg.wParam=',(Msg.wParam)]);
debugln([' Msg.lParam=',(Msg.lParam)]);
LazLoggerBase.debugln(['TLCLTaskDialog.SetProgressBarPos']);
LazLoggerBase.debugln([' Msg.wParam=',(Msg.wParam)]);
LazLoggerBase.debugln([' Msg.lParam=',(Msg.lParam)]);
if Assigned(ProgressBar) and (Msg.lParam = 0) then
begin
OldPos := ProgressBar.Position;
@ -1342,9 +1342,9 @@ begin
// wParam: TRUE to set the state of the checkbox to be checked; FALSE to set it to be unchecked.
// lParam TRUE to set the keyboard focus to the checkbox; FALSE otherwise.
// Return value is ignored
debugln('TLCLTaskDialog.ClickVerification');
debugln([' Msg.wParam=',(Msg.wParam)]);
debugln([' Msg.lParam=',(Msg.lParam)]);
LazLoggerBase.debugln('TLCLTaskDialog.ClickVerification');
LazLoggerBase.debugln([' Msg.wParam=',(Msg.wParam)]);
LazLoggerBase.debugln([' Msg.lParam=',(Msg.lParam)]);
if Assigned(VerifyCheckBox) then
begin
VerifyCheckBox.Checked := BOOL(Msg.wParam);
@ -1363,9 +1363,9 @@ begin
// wParam: An int value that specifies the ID of the button to be clicked.
// lParam: Must be zero.
// Return value is ignored
debugln('TLCLTaskDialog.ClickButton');
debugln([' Msg.wParam=',(Msg.wParam)]);
debugln([' Msg.lParam=',(Msg.lParam)]);
LazLoggerBase.debugln('TLCLTaskDialog.ClickButton');
LazLoggerBase.debugln([' Msg.wParam=',(Msg.wParam)]);
LazLoggerBase.debugln([' Msg.lParam=',(Msg.lParam)]);
if (Msg.lPARAM = 0) then
begin
@ -1383,9 +1383,9 @@ begin
// wParam: An int value that specifies the ID of the radio button to be clicked.
// lParam: Must be zero.
// Return value is ignored
debugln('TLCLTaskDialog.ClickRadioButton');
debugln([' Msg.wParam=',(Msg.wParam)]);
debugln([' Msg.lParam=',(Msg.lParam)]);
LazLoggerBase.debugln('TLCLTaskDialog.ClickRadioButton');
LazLoggerBase.debugln([' Msg.wParam=',(Msg.wParam)]);
LazLoggerBase.debugln([' Msg.lParam=',(Msg.lParam)]);
if (Msg.lParam = 0) and (FDlg.RadioButtons.Count > 0) then
begin
RadioBtn := FindRadioButtonByButtonID(Msg.wParam);
@ -1401,9 +1401,9 @@ begin
// wParam: An int value that specifies the ID of the button to be enabled/disabled.
// lParam: 0: disable the button, otherwise enable
// Return value is ignored
debugln('TLCLTaskDialog.EnableButton');
debugln([' Msg.wParam=',(Msg.wParam)]);
debugln([' Msg.lParam=',(Msg.lParam)]);
LazLoggerBase.debugln('TLCLTaskDialog.EnableButton');
LazLoggerBase.debugln([' Msg.wParam=',(Msg.wParam)]);
LazLoggerBase.debugln([' Msg.lParam=',(Msg.lParam)]);
Btn := FindButtonByButtonID(Msg.wParam);
if Assigned(Btn) then
Btn.Enabled := (Msg.lParam <> 0);
@ -1416,9 +1416,9 @@ begin
// wParam: An int value that specifies the ID of the radio button to be enabled/disabled.
// lParam: 0: disable the button, otherwise enable
// Return value is ignored
debugln('TLCLTaskDialog.EnableRadioButton');
debugln([' Msg.wParam=',(Msg.wParam)]); //ID of radiobutton
debugln([' Msg.lParam=',(Msg.lParam)]); //must be 0
LazLoggerBase.debugln('TLCLTaskDialog.EnableRadioButton');
LazLoggerBase.debugln([' Msg.wParam=',(Msg.wParam)]); //ID of radiobutton
LazLoggerBase.debugln([' Msg.lParam=',(Msg.lParam)]); //must be 0
RadioBtn := FindRadioButtonByButtonID(Msg.wParam);
if Assigned(RadioBtn) then
RadioBtn.Enabled := (Msg.lParam <> 0);
@ -1433,11 +1433,11 @@ begin
// wParam: Indicates the element to update.
// lParam: Pointer to a Unicode string that contains the new text.
// Return value is ignored.
debugln('TLCLTaskDialog.UpdateElementText');
debugln([' Msg.wParam=',(Msg.wParam)]);
debugln([' Msg.lParam=',(Msg.lParam)]);
LazLoggerBase.debugln('TLCLTaskDialog.UpdateElementText');
LazLoggerBase.debugln([' Msg.wParam=',(Msg.wParam)]);
LazLoggerBase.debugln([' Msg.lParam=',(Msg.lParam)]);
NewText := Utf16ToUtf8(Unicodestring(PWideChar(Msg.lParam)));
debugln(' NewText=',NewText);
LazLoggerBase.debugln(' NewText=',NewText);
//It seems to be that the native Vista+ dialog does not adjust heights (properly),
//if new label height is bigger, then e.g. FooterText may end up falling off the dialog...
// ToDo: do this properly:

6
lcl/widgetset/wslclclasses.pp
View File

@ -39,7 +39,7 @@ interface
// the uses clause of the XXXintf.pp
////////////////////////////////////////////////////
uses
Classes, SysUtils, LCLProc;
Classes, SysUtils, LCLProc, LazLoggerBase;
type
{ TWSPrivate }
@ -320,7 +320,7 @@ begin
if WSPrivate = TWSPrivate then begin
if ParentWSNode^.VClass = nil then begin
DebugLN('[WARNING] Missing VClass for: ', ParentWSNode^.WSClass.ClassName);
LazLoggerBase.DebugLN('[WARNING] Missing VClass for: ', ParentWSNode^.WSClass.ClassName);
PClass(ANode^.VClass + vmtWSPrivate)^ := TWSPrivate;
end
else PClass(ANode^.VClass + vmtWSPrivate)^ :=
@ -391,7 +391,7 @@ begin
Break;
end;
if idx = VvmtCount - 1 then begin
DebugLn('[WARNING] VMT entry "', Cmnt^.Entries[n].Name^,
LazLoggerBase.DebugLn('[WARNING] VMT entry "', Cmnt^.Entries[n].Name^,
'" not found in "', CommonClass.ClassName, '"');
Break;
end;

9
lcl/widgetset/wsproc.pp
View File

@ -24,8 +24,7 @@ unit WSProc;
interface
uses
LCLClasses, LCLProc, Controls, Menus;
LCLClasses, LCLProc, Controls, Menus, LazLoggerBase;
function WSCheckReferenceAllocated(const AComponent: TLCLReferenceComponent;
const AProcName: String): Boolean;
@ -43,7 +42,7 @@ function WSCheckReferenceAllocated(const AComponent: TLCLReferenceComponent;
procedure Warn;
begin
DebugLn('[WARNING] %s called without reference for %s(%s)', [AProcName, AComponent.Name, AComponent.ClassName]);
LazLoggerBase.DebugLn('[WARNING] %s called without reference for %s(%s)', [AProcName, AComponent.Name, AComponent.ClassName]);
end;
begin
Result := AComponent.ReferenceAllocated;
@ -56,7 +55,7 @@ function WSCheckHandleAllocated(const AWincontrol: TWinControl;
procedure Warn;
begin
DebugLn('[WARNING] %s called without handle for %s(%s)', [AProcName, AWincontrol.Name, AWincontrol.ClassName]);
LazLoggerBase.DebugLn('[WARNING] %s called without handle for %s(%s)', [AProcName, AWincontrol.Name, AWincontrol.ClassName]);
end;
begin
Result := AWinControl.HandleAllocated;
@ -68,7 +67,7 @@ function WSCheckHandleAllocated(const AMenu: TMenu;
const AProcName: String): Boolean;
procedure Warn;
begin
DebugLn('[WARNING] %s called without handle for %s(%s)', [AProcName, AMenu.Name, AMenu.ClassName]);
LazLoggerBase.DebugLn('[WARNING] %s called without handle for %s(%s)', [AProcName, AMenu.Name, AMenu.ClassName]);
end;
begin
Result := AMenu.HandleAllocated;