paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 23:30:22 +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, WSReferences, Graphics, ImgList, ActnList, Themes, Menus,
Controls, Forms, StdCtrls, ExtCtrls, ToolWin, Buttons, Controls, Forms, StdCtrls, ExtCtrls, ToolWin, Buttons,
// LazUtils // LazUtils
GraphType, LazUTF8, LazLoggerBase, LazUtilities, IntegerList; GraphType, LazUTF8, LazLoggerBase, LazTracer, LazUtilities, IntegerList;
type type
THitTest = (htAbove, htBelow, htNowhere, htOnItem, htOnButton, htOnIcon, THitTest = (htAbove, htBelow, htNowhere, htOnItem, htOnButton, htOnIcon,

2
lcl/forms.pp
View File

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

6
lcl/include/application.inc
View File

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

2
lcl/include/customcombobox.inc
View File

@ -72,7 +72,7 @@ procedure TCustomComboBox.DestroyWnd;
var var
NewStrings: TStrings; NewStrings: TStrings;
begin begin
if not HandleAllocated then RaiseGDBException(''); if not HandleAllocated then LazTracer.RaiseGDBException('');
// store itemindex // store itemindex
FItemIndex := TWSCustomComboBoxClass(WidgetSetClass).GetItemIndex(Self); FItemIndex := TWSCustomComboBoxClass(WidgetSetClass).GetItemIndex(Self);
// create an internal list for storing items internally // 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; procedure TCustomForm.AddHandler(HandlerType: TFormHandlerType;
const Handler: TMethod; AsFirst: Boolean); const Handler: TMethod; AsFirst: Boolean);
begin begin
if Handler.Code=nil then RaiseGDBException('TCustomForm.AddHandler'); if Handler.Code=nil then LazTracer.RaiseGDBException('TCustomForm.AddHandler');
if FFormHandlers[HandlerType]=nil then if FFormHandlers[HandlerType]=nil then
FFormHandlers[HandlerType]:=TMethodList.Create; FFormHandlers[HandlerType]:=TMethodList.Create;
FFormHandlers[HandlerType].Add(Handler,not AsFirst); FFormHandlers[HandlerType].Add(Handler,not AsFirst);

2
lcl/include/customlistview.inc
View File

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

4
lcl/include/menuitem.inc
View File

@ -132,7 +132,7 @@ procedure TMenuItem.CreateHandle;
begin begin
//DebugLn('TMenuItem.CreateHandle ',dbgsName(Self),' ',dbgs(Self)); //DebugLn('TMenuItem.CreateHandle ',dbgsName(Self),' ',dbgs(Self));
//DebugLn('TMenuItem.CreateHandle START ',Name,':',ClassName); //DebugLn('TMenuItem.CreateHandle START ',Name,':',ClassName);
if not FVisible then RaiseGDBException(''); if not FVisible then LazTracer.RaiseGDBException('');
FHandle := TWSMenuItemClass(WidgetSetClass).CreateHandle(Self); FHandle := TWSMenuItemClass(WidgetSetClass).CreateHandle(Self);
CheckChildrenHandles; CheckChildrenHandles;
@ -876,7 +876,7 @@ procedure TMenuItem.Insert(Index: Integer; Item: TMenuItem);
begin begin
if (Item = nil) then exit; if (Item = nil) then exit;
if Item.Parent <> nil then if Item.Parent <> nil then
RaiseGDBException('Menu inserted twice'); LazTracer.RaiseGDBException('Menu inserted twice');
// create Items if needed // create Items if needed
if FItems = nil then FItems := TMenuItems.Create(Self); 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 (csDestroying in ACustomForm.ComponentState) or
(FCustomForms.IndexOf(ACustomForm)<0) (FCustomForms.IndexOf(ACustomForm)<0)
then then
RaiseGDBException('TScreen.MoveFormToFocusFront'); LazTracer.RaiseGDBException('TScreen.MoveFormToFocusFront');
if (FCustomForms.Count=0) or (TObject(FCustomForms[0])<>ACustomForm) then if (FCustomForms.Count=0) or (TObject(FCustomForms[0])<>ACustomForm) then
begin begin
FCustomForms.Remove(ACustomForm); FCustomForms.Remove(ACustomForm);
@ -175,7 +175,7 @@ begin
(csDestroying in ACustomForm.ComponentState) or (csDestroying in ACustomForm.ComponentState) or
(FCustomForms.IndexOf(ACustomForm)<0) (FCustomForms.IndexOf(ACustomForm)<0)
then then
RaiseGDBException('TScreen.MoveFormToZFront'); LazTracer.RaiseGDBException('TScreen.MoveFormToZFront');
if (FCustomFormsZOrdered.Count = 0) or if (FCustomFormsZOrdered.Count = 0) or
(TObject(FCustomFormsZOrdered[0]) <> ACustomForm) then (TObject(FCustomFormsZOrdered[0]) <> ACustomForm) then
@ -497,7 +497,7 @@ begin
for i := 0 to MonitorCount - 1 do for i := 0 to MonitorCount - 1 do
if Monitors[i].Handle = AHandle then if Monitors[i].Handle = AHandle then
Exit(Monitors[i]); Exit(Monitors[i]);
RaiseGDBException(AErrorMsg); // internal error LazTracer.RaiseGDBException(AErrorMsg); // internal error
end; end;
function TScreen.MonitorFromPoint(const Point: TPoint; function TScreen.MonitorFromPoint(const Point: TPoint;
@ -1145,7 +1145,7 @@ procedure TScreen.AddHandler(HandlerType: TScreenNotification;
const Handler: TMethod; AsFirst: Boolean); const Handler: TMethod; AsFirst: Boolean);
begin begin
if Handler.Code = nil then if Handler.Code = nil then
RaiseGDBException('TScreen.AddHandler'); LazTracer.RaiseGDBException('TScreen.AddHandler');
if FScreenHandlers[HandlerType] = nil then if FScreenHandlers[HandlerType] = nil then
FScreenHandlers[HandlerType] := TMethodList.Create; FScreenHandlers[HandlerType] := TMethodList.Create;
FScreenHandlers[HandlerType].Add(Handler, not AsFirst); FScreenHandlers[HandlerType].Add(Handler, not AsFirst);

2
lcl/include/scrollbar.inc
View File

@ -48,7 +48,7 @@ var
ScrollInfo: TScrollInfo; ScrollInfo: TScrollInfo;
begin begin
inherited CreateWnd; 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.cbSize := SizeOf(ScrollInfo);
ScrollInfo.nMin := FMin; ScrollInfo.nMin := FMin;
ScrollInfo.nMax := FMax; ScrollInfo.nMax := FMax;

2
lcl/include/statusbar.inc
View File

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

2
lcl/include/tabcontrol.inc
View File

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

112
lcl/include/treeview.inc
View File

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

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

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

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

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

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

@ -60,7 +60,7 @@ begin
n := FTimerData.Count; n := FTimerData.Count;
if (n > 0) then if (n > 0) then
begin 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 while (n > 0) do
begin begin
dec(n); dec(n);
@ -120,7 +120,7 @@ begin
Done := True; Done := True;
if not WinRegister then if not WinRegister then
begin begin
DebugLn('Trace:Win32Object.Init - Register Failed'); LazLoggerBase.DebugLn('Trace:Win32Object.Init - Register Failed');
Exit; Exit;
end; end;
@ -430,7 +430,7 @@ begin
end else end else
if retVal = $FFFFFFFF then if retVal = $FFFFFFFF then
begin begin
DebugLn('[TWin32WidgetSet.AppProcessMessages] MsgWaitForMultipleObjects returned: ', IntToStr(GetLastError)); LazLoggerBase.DebugLn('[TWin32WidgetSet.AppProcessMessages] MsgWaitForMultipleObjects returned: ', IntToStr(GetLastError));
break; break;
end; end;
until false; until false;

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

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

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

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

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

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

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

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

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

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

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

@ -33,7 +33,7 @@ uses
WSMenus, WSLCLClasses, WSProc, WSMenus, WSLCLClasses, WSProc,
Windows, Controls, Classes, SysUtils, Win32Int, Win32Proc, Win32WSImgList, Windows, Controls, Classes, SysUtils, Win32Int, Win32Proc, Win32WSImgList,
LCLProc, Themes, UxTheme, Win32Themes, Win32Extra, LCLProc, Themes, UxTheme, Win32Themes, Win32Extra,
FileUtil, LazUTF8; FileUtil, LazUTF8, LazLoggerBase, LazTracer;
type type
@ -1509,14 +1509,14 @@ begin
MenuInfo.hSubmenu := ParentMenuHandle; MenuInfo.hSubmenu := ParentMenuHandle;
CallMenuRes := SetMenuItemInfoW(ParentOfParent, AMenuItem.MergedParent.Command, False, @MenuInfo); CallMenuRes := SetMenuItemInfoW(ParentOfParent, AMenuItem.MergedParent.Command, False, @MenuInfo);
if not CallMenuRes then if not CallMenuRes then
DebugLn(['SetMenuItemInfo failed: ', GetLastErrorReport]); LazLoggerBase.DebugLn(['SetMenuItemInfo failed: ', GetLastErrorReport]);
end; end;
end; end;
end; end;
ItemIndex := AMenuItem.MergedParent.VisibleIndexOf(AMenuItem); ItemIndex := AMenuItem.MergedParent.VisibleIndexOf(AMenuItem);
if ItemIndex<0 then 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 // 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 // the MDI child's window menu, so we need to take that into account
if Assigned(Application.MainForm) and if Assigned(Application.MainForm) and
@ -1571,7 +1571,7 @@ begin
end; end;
CallMenuRes := InsertMenuItemW(ParentMenuHandle, ItemIndex, True, @MenuInfo); CallMenuRes := InsertMenuItemW(ParentMenuHandle, ItemIndex, True, @MenuInfo);
if not CallMenuRes then if not CallMenuRes then
DebugLn(['InsertMenuItem failed with error: ', GetLastErrorReport]); LazLoggerBase.DebugLn(['InsertMenuItem failed with error: ', GetLastErrorReport]);
TriggerFormUpdate(AMenuItem); TriggerFormUpdate(AMenuItem);
end; end;
@ -1608,7 +1608,7 @@ begin
MenuInfo.hSubmenu := 0; MenuInfo.hSubmenu := 0;
CallMenuRes := SetMenuItemInfoW(ParentOfParentHandle, AMenuItem.MergedParent.Command, False, @MenuInfo); CallMenuRes := SetMenuItemInfoW(ParentOfParentHandle, AMenuItem.MergedParent.Command, False, @MenuInfo);
if not CallMenuRes then 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 // Set menu item info destroys/corrupts our internal popup menu for the
// unknown reason. We need to recreate it. // unknown reason. We need to recreate it.
if not IsMenu(ParentHandle) then 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'; procedure CloseDebugOutput; deprecated 'Use DebugLogger.Finish instead';
function DbgS(const c: cardinal): string; overload; deprecated 'Use DebugLogger.Dbgs instead'; function DbgS(const c: cardinal): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const i: longint): string; overload; deprecated 'Use DebugLogger.Dbgs instead'; function DbgS(const i: longint): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const i: int64): string; overload; deprecated 'Use DebugLogger.Dbgs instead'; function DbgS(const i: int64): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const q: qword): string; overload; deprecated 'Use DebugLogger.Dbgs instead'; function DbgS(const q: qword): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const r: TRect): string; overload; deprecated 'Use DebugLogger.Dbgs instead'; function DbgS(const r: TRect): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const p: TPoint): string; overload; deprecated 'Use DebugLogger.Dbgs instead'; function DbgS(const p: TPoint): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const p: pointer): string; overload; deprecated 'Use DebugLogger.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 DebugLogger.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 DebugLogger.Dbgs instead'; function DbgS(const b: boolean): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const s: TComponentState): string; overload; deprecated 'Use DebugLogger.Dbgs instead'; function DbgS(const s: TComponentState): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const m: TMethod): string; overload; deprecated 'Use DebugLogger.Dbgs instead'; function DbgS(const m: TMethod): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgSName(const p: TObject): string; overload; deprecated 'Use DebugLogger.DbgSName instead'; function DbgSName(const p: TObject): string; overload; deprecated 'Use LazLoggerBase.DbgSName instead';
function DbgSName(const p: TClass): string; overload; deprecated 'Use DebugLogger.DbgSName instead'; function DbgSName(const p: TClass): string; overload; deprecated 'Use LazLoggerBase.DbgSName instead';
function DbgStr(const StringWithSpecialChars: string): string; overload; function DbgStr(const StringWithSpecialChars: string): string; overload;
deprecated 'Use DebugLogger.DbgStr instead'; deprecated 'Use LazLoggerBase.DbgStr instead';
function DbgWideStr(const StringWithSpecialChars: widestring): string; overload; 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; 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; function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string; overload;
deprecated 'Use DebugLogger.dbgMemStream instead'; deprecated 'Use LazLoggerBase.dbgMemStream instead';
function dbgObjMem(AnObject: TObject): string; overload; deprecated 'Use DebugLogger.dbgObjMem instead'; function dbgObjMem(AnObject: TObject): string; overload; deprecated 'Use LazLoggerBase.dbgObjMem instead';
function dbgHex(i: Int64): string; overload; deprecated 'Use DebugLogger.dbgHex instead'; function dbgHex(i: Int64): string; overload; deprecated 'Use LazLoggerBase.dbgHex instead';
function DbgS(const i1,i2,i3,i4: integer): string; overload; deprecated 'Use DebugLogger.Dbgs 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 DebugLogger.Dbgs instead'; function DbgS(const Shift: TShiftState): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgS(const ASize: TSize): string; overload; deprecated 'Use DebugLogger.Dbgs instead'; function DbgS(const ASize: TSize): string; overload; deprecated 'Use LazLoggerBase.Dbgs instead';
function DbgSWindowPosFlags(Flags: UInt): String; function DbgSWindowPosFlags(Flags: UInt): String;
function DbgsVKCode(c: word): string; function DbgsVKCode(c: word): string;
@ -1382,7 +1382,7 @@ begin
VK_LCL_ENDCALL: Result:='VK_LCL_ENDCALL'; VK_LCL_ENDCALL: Result:='VK_LCL_ENDCALL';
VK_LCL_AT: Result:='VK_LCL_AT'; VK_LCL_AT: Result:='VK_LCL_AT';
else else
Result:='VK_('+dbgs(c)+')'; Result:='VK_('+LazLoggerBase.dbgs(c)+')';
end; end;
end; end;
@ -1390,26 +1390,26 @@ function DbgS(const ATM: TTextMetric): string;
begin begin
with ATM do with ATM do
Result := Result :=
'tmHeight: ' + DbgS(tmHeight) + 'tmHeight: ' + LazLoggerBase.DbgS(tmHeight) +
' tmAscent: ' + DbgS(tmAscent) + ' tmAscent: ' + LazLoggerBase.DbgS(tmAscent) +
' tmDescent: ' + DbgS(tmDescent) + ' tmDescent: ' + LazLoggerBase.DbgS(tmDescent) +
' tmInternalLeading: ' + DbgS(tmInternalLeading) + ' tmInternalLeading: ' + LazLoggerBase.DbgS(tmInternalLeading) +
' tmExternalLeading: ' + DbgS(tmExternalLeading) + ' tmExternalLeading: ' + LazLoggerBase.DbgS(tmExternalLeading) +
' tmAveCharWidth: ' + DbgS(tmAveCharWidth) + ' tmAveCharWidth: ' + LazLoggerBase.DbgS(tmAveCharWidth) +
' tmMaxCharWidth: ' + DbgS(tmMaxCharWidth) + ' tmMaxCharWidth: ' + LazLoggerBase.DbgS(tmMaxCharWidth) +
' tmWeight: ' + DbgS(tmWeight) + ' tmWeight: ' + LazLoggerBase.DbgS(tmWeight) +
' tmOverhang: ' + DbgS(tmOverhang) + ' tmOverhang: ' + LazLoggerBase.DbgS(tmOverhang) +
' tmDigitizedAspectX: ' + DbgS(tmDigitizedAspectX) + ' tmDigitizedAspectX: ' + LazLoggerBase.DbgS(tmDigitizedAspectX) +
' tmDigitizedAspectY: ' + DbgS(tmDigitizedAspectY) + ' tmDigitizedAspectY: ' + LazLoggerBase.DbgS(tmDigitizedAspectY) +
' tmFirstChar: ' + tmFirstChar + ' tmFirstChar: ' + tmFirstChar +
' tmLastChar: ' + tmLastChar + ' tmLastChar: ' + tmLastChar +
' tmDefaultChar: ' + tmDefaultChar + ' tmDefaultChar: ' + tmDefaultChar +
' tmBreakChar: ' + tmBreakChar + ' tmBreakChar: ' + tmBreakChar +
' tmItalic: ' + DbgS(tmItalic) + ' tmItalic: ' + LazLoggerBase.DbgS(tmItalic) +
' tmUnderlined: ' + DbgS(tmUnderlined) + ' tmUnderlined: ' + LazLoggerBase.DbgS(tmUnderlined) +
' tmStruckOut: ' + DbgS(tmStruckOut) + ' tmStruckOut: ' + LazLoggerBase.DbgS(tmStruckOut) +
' tmPitchAndFamily: ' + DbgS(tmPitchAndFamily) + ' tmPitchAndFamily: ' + LazLoggerBase.DbgS(tmPitchAndFamily) +
' tmCharSet: ' + DbgS(tmCharSet); ' tmCharSet: ' + LazLoggerBase.DbgS(tmCharSet);
end; end;
function DbgS(const AScrollInfo: TScrollInfo): string; function DbgS(const AScrollInfo: TScrollInfo): string;
@ -1417,14 +1417,14 @@ begin
Result := ''; Result := '';
if (SIF_POS and AScrollInfo.fMask) > 0 then 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 if (SIF_RANGE and AScrollInfo.fMask) > 0 then
Result := Result + ' Min: ' + DbgS(AScrollInfo.nMin) + ' Max: ' + Result := Result + ' Min: ' + LazLoggerBase.DbgS(AScrollInfo.nMin) +
DbgS(AScrollInfo.nMax); ' Max: ' + LazLoggerBase.DbgS(AScrollInfo.nMax);
if (SIF_PAGE and AScrollInfo.fMask) > 0 then 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 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)'; if Result = '' then Result := '(no scrollinfo)';
end; end;
@ -1473,18 +1473,18 @@ begin
s:=''; s:='';
for i:=Low(Args) to High(Args) do begin for i:=Low(Args) to High(Args) do begin
case Args[i].VType of case Args[i].VType of
vtInteger: s:=s+dbgs(Args[i].vinteger); vtInteger: s:=s+LazLoggerBase.dbgs(Args[i].vinteger);
vtInt64: s:=s+dbgs(Args[i].VInt64^); vtInt64: s:=s+LazLoggerBase.dbgs(Args[i].VInt64^);
vtQWord: s:=s+dbgs(Args[i].VQWord^); vtQWord: s:=s+LazLoggerBase.dbgs(Args[i].VQWord^);
vtBoolean: s:=s+dbgs(Args[i].vboolean); vtBoolean: s:=s+LazLoggerBase.dbgs(Args[i].vboolean);
vtExtended: s:=s+dbgs(Args[i].VExtended^); vtExtended: s:=s+LazLoggerBase.dbgs(Args[i].VExtended^);
{$ifdef FPC_CURRENCY_IS_INT64} {$ifdef FPC_CURRENCY_IS_INT64}
// MWE: // MWE:
// ppcppc 2.0.2 has troubles in choosing the right dbgs() // ppcppc 2.0.2 has troubles in choosing the right dbgs()
// so we convert here (i don't know about other versions // 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} {$else}
vtCurrency: s:=s+dbgs(Args[i].vCurrency^); vtCurrency: s:=s+LazLoggerBase.dbgs(Args[i].vCurrency^);
{$endif} {$endif}
vtString: s:=s+Args[i].VString^; vtString: s:=s+Args[i].VString^;
vtAnsiString: s:=s+AnsiString(Args[i].VAnsiString); vtAnsiString: s:=s+AnsiString(Args[i].VAnsiString);
@ -1494,9 +1494,9 @@ begin
vtWideChar: s:=AnsiString(WideString(s)+Args[i].VWideChar); vtWideChar: s:=AnsiString(WideString(s)+Args[i].VWideChar);
vtWidestring: s:=AnsiString(WideString(s)+WideString(Args[i].VWideString)); vtWidestring: s:=AnsiString(WideString(s)+WideString(Args[i].VWideString));
vtUnicodeString: s:=AnsiString(UnicodeString(s)+UnicodeString(Args[i].VUnicodeString)); vtUnicodeString: s:=AnsiString(UnicodeString(s)+UnicodeString(Args[i].VUnicodeString));
vtObject: s:=s+DbgSName(Args[i].VObject); vtObject: s:=s+LazLoggerBase.DbgSName(Args[i].VObject);
vtClass: s:=s+DbgSName(Args[i].VClass); vtClass: s:=s+LazLoggerBase.DbgSName(Args[i].VClass);
vtPointer: s:=s+Dbgs(Args[i].VPointer); vtPointer: s:=s+LazLoggerBase.Dbgs(Args[i].VPointer);
else else
DbgOutThreadLog('?unknown variant?'); DbgOutThreadLog('?unknown variant?');
end; end;
@ -1683,18 +1683,18 @@ var
procedure RaiseNotCreated; procedure RaiseNotCreated;
begin begin
DebugLn('TDebugLCLItems.MarkDestroyed not created: p=',dbgs(p)); LazLoggerBase.DebugLn('TDebugLCLItems.MarkDestroyed not created: p=',LazLoggerBase.dbgs(p));
DumpStack; DumpStack;
RaiseGDBException('TDebugLCLItems.MarkDestroyed'); LazTracer.RaiseGDBException('TDebugLCLItems.MarkDestroyed');
end; end;
procedure RaiseDoubleDestroyed; procedure RaiseDoubleDestroyed;
begin begin
debugLn('TDebugLCLItems.MarkDestroyed Double destroyed:'); LazLoggerBase.debugLn('TDebugLCLItems.MarkDestroyed Double destroyed:');
debugln(Info.AsString(true)); LazLoggerBase.debugln(Info.AsString(true));
debugln('Now:'); LazLoggerBase.debugln('Now:');
DebugLn(GetStackTrace(true)); LazLoggerBase.DebugLn(GetStackTrace(true));
RaiseGDBException('RaiseDoubleDestroyed'); LazTracer.RaiseGDBException('RaiseDoubleDestroyed');
end; end;
begin begin
@ -1726,11 +1726,11 @@ var
procedure RaiseDoubleCreated; procedure RaiseDoubleCreated;
begin begin
debugLn('TDebugLCLItems.MarkCreated CREATED TWICE. Old:'); LazLoggerBase.debugLn('TDebugLCLItems.MarkCreated CREATED TWICE. Old:');
debugln(Info.AsString(true)); LazLoggerBase.debugln(Info.AsString(true));
debugln(' New=',dbgs(p),' InfoText="',InfoText,'"'); LazLoggerBase.debugln(' New=',LazLoggerBase.dbgs(p),' InfoText="',InfoText,'"');
DebugLn(GetStackTrace(true)); LazLoggerBase.DebugLn(GetStackTrace(true));
RaiseGDBException('RaiseDoubleCreated'); LazTracer.RaiseGDBException('RaiseDoubleCreated');
end; end;
begin begin
@ -1755,8 +1755,8 @@ end;
function TDebugLCLItemInfo.AsString(WithStackTraces: boolean): string; function TDebugLCLItemInfo.AsString(WithStackTraces: boolean): string;
begin begin
Result:='Item='+Dbgs(Item)+LineEnding Result:='Item='+LazLoggerBase.Dbgs(Item)+LineEnding
+'Info="'+DbgStr(Info)+LineEnding; +'Info="'+LazLoggerBase.DbgStr(Info)+LineEnding;
if WithStackTraces then if WithStackTraces then
Result:=Result+'Creation:'+LineEnding+StackTraceAsString(CreationStack,true); Result:=Result+'Creation:'+LineEnding+StackTraceAsString(CreationStack,true);
if IsDestroyed then begin if IsDestroyed then begin

2
lcl/menus.pp
View File

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

2
lcl/printers.pas
View File

@ -978,7 +978,7 @@ end;
procedure TPrinter.DoSetBinName(aName: string); procedure TPrinter.DoSetBinName(aName: string);
begin begin
if SupportedBins.Count>0 then if SupportedBins.Count>0 then
DebugLn('Warning: bin %s is not allowed',[aName]); LazLoggerBase.DebugLn('Warning: bin %s is not allowed',[aName]);
end; end;
//Initialise aPaperRc with the aName paper rect //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, LCLStrConsts, LCLType, LCLProc, LCLIntf, LMessages, LResources, Graphics,
ActnList, Controls, Forms, Menus, Themes, ActnList, Controls, Forms, Menus, Themes,
// LazUtils // LazUtils
TextStrings, ExtendedStrings, LazUTF8, LazMethodList, LazLoggerBase, LazUtilities; TextStrings, ExtendedStrings, LazUTF8, LazMethodList, LazLoggerBase, LazTracer, LazUtilities;
type type

66
lcl/taskdlgemulation.pp
View File

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

6
lcl/widgetset/wslclclasses.pp
View File

@ -39,7 +39,7 @@ interface
// the uses clause of the XXXintf.pp // the uses clause of the XXXintf.pp
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
uses uses
Classes, SysUtils, LCLProc; Classes, SysUtils, LCLProc, LazLoggerBase;
type type
{ TWSPrivate } { TWSPrivate }
@ -320,7 +320,7 @@ begin
if WSPrivate = TWSPrivate then begin if WSPrivate = TWSPrivate then begin
if ParentWSNode^.VClass = nil 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; PClass(ANode^.VClass + vmtWSPrivate)^ := TWSPrivate;
end end
else PClass(ANode^.VClass + vmtWSPrivate)^ := else PClass(ANode^.VClass + vmtWSPrivate)^ :=
@ -391,7 +391,7 @@ begin
Break; Break;
end; end;
if idx = VvmtCount - 1 then begin 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, '"'); '" not found in "', CommonClass.ClassName, '"');
Break; Break;
end; end;

9
lcl/widgetset/wsproc.pp
View File

@ -24,8 +24,7 @@ unit WSProc;
interface interface
uses uses
LCLClasses, LCLProc, Controls, Menus; LCLClasses, LCLProc, Controls, Menus, LazLoggerBase;
function WSCheckReferenceAllocated(const AComponent: TLCLReferenceComponent; function WSCheckReferenceAllocated(const AComponent: TLCLReferenceComponent;
const AProcName: String): Boolean; const AProcName: String): Boolean;
@ -43,7 +42,7 @@ function WSCheckReferenceAllocated(const AComponent: TLCLReferenceComponent;
procedure Warn; procedure Warn;
begin 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; end;
begin begin
Result := AComponent.ReferenceAllocated; Result := AComponent.ReferenceAllocated;
@ -56,7 +55,7 @@ function WSCheckHandleAllocated(const AWincontrol: TWinControl;
procedure Warn; procedure Warn;
begin 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; end;
begin begin
Result := AWinControl.HandleAllocated; Result := AWinControl.HandleAllocated;
@ -68,7 +67,7 @@ function WSCheckHandleAllocated(const AMenu: TMenu;
const AProcName: String): Boolean; const AProcName: String): Boolean;
procedure Warn; procedure Warn;
begin 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; end;
begin begin
Result := AMenu.HandleAllocated; Result := AMenu.HandleAllocated;