paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-19 00:39:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

TButtonGlyph now uses shared bitmaps, improved debugging mem leaks

Browse Source 
git-svn-id: trunk@9629 -
This commit is contained in:
mattias 2006-07-18 17:20:34 +00:00
parent 88558ed640
commit b17384ebc1
15 changed files with 231 additions and 338 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

188
examples/multithreading/waitforexample1.lpi
View File

@ -4,13 +4,13 @@
<PathDelim Value="/"/> <PathDelim Value="/"/>
<Version Value="5"/> <Version Value="5"/>
<General> <General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/> <TargetFileExt Value=""/>
<ActiveEditorIndexAtStart Value="0"/>
</General> </General>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions> </PublishOptions>
@ -25,16 +25,11 @@
<PackageName Value="LCL"/> <PackageName Value="LCL"/>
</Item1> </Item1>
</RequiredPackages> </RequiredPackages>
<Units Count="8"> <Units Count="2">
<Unit0> <Unit0>
<Filename Value="waitforexample1.lpr"/> <Filename Value="waitforexample1.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="WaitForExample1"/> <UnitName Value="WaitForExample1"/>
<CursorPos X="8" Y="14"/>
<TopLine Value="1"/>
<EditorIndex Value="1"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="waitforunit1.pas"/> <Filename Value="waitforunit1.pas"/>
@ -42,185 +37,8 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ResourceFilename Value="waitforunit1.lrs"/> <ResourceFilename Value="waitforunit1.lrs"/>
<UnitName Value="WaitForUnit1"/> <UnitName Value="WaitForUnit1"/>
<CursorPos X="20" Y="32"/>
<TopLine Value="1"/>
<EditorIndex Value="0"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit1> </Unit1>
<Unit2>
<Filename Value="mainunit.pas"/>
<UnitName Value="MainUnit"/>
<CursorPos X="1" Y="27"/>
<TopLine Value="1"/>
<EditorIndex Value="7"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="../../../freepascal/fpc/fcl/inc/custapp.pp"/>
<UnitName Value="CustApp"/>
<CursorPos X="14" Y="69"/>
<TopLine Value="47"/>
<EditorIndex Value="6"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="../../../freepascal/fpc/rtl/objpas/classes/classesh.inc"/>
<CursorPos X="18" Y="1220"/>
<TopLine Value="1196"/>
<EditorIndex Value="3"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="../../../freepascal/fpc/rtl/objpas/classes/classes.inc"/>
<CursorPos X="1" Y="103"/>
<TopLine Value="75"/>
<EditorIndex Value="5"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="../../../freepascal/fpc/rtl/inc/threadh.inc"/>
<CursorPos X="59" Y="136"/>
<TopLine Value="110"/>
<EditorIndex Value="2"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit6>
<Unit7>
<Filename Value="../../../freepascal/fpc/rtl/linux/tthread.inc"/>
<CursorPos X="3" Y="292"/>
<TopLine Value="290"/>
<EditorIndex Value="4"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit7>
</Units> </Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="waitforunit1.pas"/>
<Caret Line="158" Column="1" TopLine="122"/>
</Position1>
<Position2>
<Filename Value="waitforunit1.pas"/>
<Caret Line="112" Column="11" TopLine="90"/>
</Position2>
<Position3>
<Filename Value="waitforunit1.pas"/>
<Caret Line="102" Column="1" TopLine="90"/>
</Position3>
<Position4>
<Filename Value="waitforunit1.pas"/>
<Caret Line="145" Column="1" TopLine="109"/>
</Position4>
<Position5>
<Filename Value="waitforunit1.pas"/>
<Caret Line="45" Column="1" TopLine="45"/>
</Position5>
<Position6>
<Filename Value="waitforunit1.pas"/>
<Caret Line="145" Column="19" TopLine="109"/>
</Position6>
<Position7>
<Filename Value="waitforunit1.pas"/>
<Caret Line="72" Column="1" TopLine="50"/>
</Position7>
<Position8>
<Filename Value="waitforunit1.pas"/>
<Caret Line="144" Column="22" TopLine="108"/>
</Position8>
<Position9>
<Filename Value="waitforunit1.pas"/>
<Caret Line="110" Column="5" TopLine="56"/>
</Position9>
<Position10>
<Filename Value="waitforunit1.pas"/>
<Caret Line="105" Column="15" TopLine="102"/>
</Position10>
<Position11>
<Filename Value="waitforunit1.pas"/>
<Caret Line="76" Column="1" TopLine="54"/>
</Position11>
<Position12>
<Filename Value="waitforunit1.pas"/>
<Caret Line="114" Column="8" TopLine="96"/>
</Position12>
<Position13>
<Filename Value="waitforunit1.pas"/>
<Caret Line="115" Column="5" TopLine="93"/>
</Position13>
<Position14>
<Filename Value="waitforunit1.pas"/>
<Caret Line="53" Column="25" TopLine="26"/>
</Position14>
<Position15>
<Filename Value="waitforunit1.pas"/>
<Caret Line="45" Column="25" TopLine="23"/>
</Position15>
<Position16>
<Filename Value="waitforunit1.pas"/>
<Caret Line="118" Column="62" TopLine="96"/>
</Position16>
<Position17>
<Filename Value="waitforunit1.pas"/>
<Caret Line="133" Column="7" TopLine="111"/>
</Position17>
<Position18>
<Filename Value="waitforunit1.pas"/>
<Caret Line="40" Column="36" TopLine="18"/>
</Position18>
<Position19>
<Filename Value="waitforunit1.pas"/>
<Caret Line="66" Column="15" TopLine="35"/>
</Position19>
<Position20>
<Filename Value="waitforunit1.pas"/>
<Caret Line="133" Column="1" TopLine="101"/>
</Position20>
<Position21>
<Filename Value="waitforunit1.pas"/>
<Caret Line="21" Column="1" TopLine="1"/>
</Position21>
<Position22>
<Filename Value="waitforunit1.pas"/>
<Caret Line="149" Column="11" TopLine="116"/>
</Position22>
<Position23>
<Filename Value="waitforunit1.pas"/>
<Caret Line="71" Column="12" TopLine="49"/>
</Position23>
<Position24>
<Filename Value="waitforunit1.pas"/>
<Caret Line="103" Column="38" TopLine="81"/>
</Position24>
<Position25>
<Filename Value="waitforunit1.pas"/>
<Caret Line="102" Column="1" TopLine="81"/>
</Position25>
<Position26>
<Filename Value="waitforunit1.pas"/>
<Caret Line="148" Column="11" TopLine="115"/>
</Position26>
<Position27>
<Filename Value="waitforunit1.pas"/>
<Caret Line="129" Column="5" TopLine="114"/>
</Position27>
<Position28>
<Filename Value="waitforunit1.pas"/>
<Caret Line="150" Column="1" TopLine="114"/>
</Position28>
<Position29>
<Filename Value="waitforunit1.pas"/>
<Caret Line="147" Column="1" TopLine="116"/>
</Position29>
<Position30>
<Filename Value="waitforunit1.pas"/>
<Caret Line="152" Column="3" TopLine="118"/>
</Position30>
</JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="5"/> <Version Value="5"/>

177
ide/componentpalette.pas
View File

@ -451,99 +451,104 @@ begin
exit; exit;
end; end;
//writeln('TComponentPalette.UpdateNoteBookButtons A'); //writeln('TComponentPalette.UpdateNoteBookButtons A');
// lock
fUpdatingNotebook:=true; fUpdatingNotebook:=true;
OldActivePage:=FNoteBook.ActivePage; FNoteBook.DisableAlign;
// remove every page in the notebook without a visible page try
for i:=FNoteBook.PageCount-1 downto 0 do begin OldActivePage:=FNoteBook.ActivePage;
PageIndex:=IndexOfPageComponent(FNoteBook.Page[i]); // remove every page in the notebook without a visible page
if (PageIndex<0) or (not Pages[PageIndex].Visible) then begin for i:=FNoteBook.PageCount-1 downto 0 do begin
if PageIndex>=0 then PageIndex:=IndexOfPageComponent(FNoteBook.Page[i]);
Pages[i].PageComponent:=nil; if (PageIndex<0) or (not Pages[PageIndex].Visible) then begin
FNoteBook.Pages.Delete(i); if PageIndex>=0 then
end; Pages[i].PageComponent:=nil;
end; FNoteBook.Pages.Delete(i);
// insert a notebook page for every visible palette page
PageIndex:=0;
for i:=0 to Count-1 do begin
if not Pages[i].Visible then continue;
if Pages[i].PageComponent=nil then begin
// insert a new notebook page
FNoteBook.Pages.Insert(PageIndex,Pages[i].PageName);
Pages[i].PageComponent:=FNoteBook.Page[PageIndex];
end else begin
// move to the right position
CurPageIndex:=TPage(Pages[i].PageComponent).PageIndex;
if CurPageIndex<>PageIndex then
FNoteBook.Pages.Move(CurPageIndex,PageIndex);
end;
inc(PageIndex);
end;
// create a speedbutton for every visible component
for i:=0 to Count-1 do begin
CurPage:=Pages[i];
if not CurPage.Visible then continue;
CurNoteBookPage:=TPage(CurPage.PageComponent);
if not (CurNoteBookPage is TPage) then RaiseException('CurNoteBookPage');
ButtonX:=0;
// create selection button
if CurPage.SelectButton=nil then begin
CurBtn:=TSpeedButton.Create(nil);
CurPage.SelectButton:=CurBtn;
with CurBtn do begin
Name:='PaletteSelectBtn'+IntToStr(i);
Parent:=CurNoteBookPage;
OnClick := @SelectionToolClick;
Glyph.LoadFromLazarusResource('tmouse');
Flat := True;
GroupIndex:= 1;
Down := True;
Hint := lisSelectionTool;
SetBounds(ButtonX,0,ComponentPaletteBtnWidth,ComponentPaletteBtnHeight);
end; end;
end; end;
inc(ButtonX,((ComponentPaletteBtnWidth*3) div 2)+2); // insert a notebook page for every visible palette page
// create component buttons PageIndex:=0;
for j:=0 to CurPage.Count-1 do begin for i:=0 to Count-1 do begin
CurComponent:=TPkgComponent(CurPage[j]); if not Pages[i].Visible then continue;
if CurComponent.Visible then begin if Pages[i].PageComponent=nil then begin
if CurComponent.Button=nil then begin // insert a new notebook page
CurBtn:=TSpeedButton.Create(nil); FNoteBook.Pages.Insert(PageIndex,Pages[i].PageName);
CurComponent.Button:=CurBtn; Pages[i].PageComponent:=FNoteBook.Page[PageIndex];
CreatePopupMenu; end else begin
with CurBtn do begin // move to the right position
Name:='PaletteBtnPage'+IntToStr(i)+'_'+IntToStr(j) CurPageIndex:=TPage(Pages[i].PageComponent).PageIndex;
+'_'+CurComponent.ComponentClass.ClassName; if CurPageIndex<>PageIndex then
Parent := CurNoteBookPage; FNoteBook.Pages.Move(CurPageIndex,PageIndex);
SetBounds(ButtonX,0,ComponentPaletteBtnWidth,ComponentPaletteBtnHeight); end;
Glyph := CurComponent.GetIconCopy; inc(PageIndex);
GroupIndex := 1; end;
Flat := true; // create a speedbutton for every visible component
OnClick := @ComponentBtnClick; for i:=0 to Count-1 do begin
OnDblClick := @ComponentBtnDblClick; CurPage:=Pages[i];
Hint := CurComponent.ComponentClass.ClassName; if not CurPage.Visible then continue;
CurBtn.PopupMenu:=Self.PopupMenu; CurNoteBookPage:=TPage(CurPage.PageComponent);
Visible:=true; if not (CurNoteBookPage is TPage) then RaiseException('CurNoteBookPage');
end; ButtonX:=0;
//writeln('TComponentPalette.UpdateNoteBookButtons Created Button: ',CurComponent.ComponentClass.ClassName,' ',CurComponent.Button.Name); // create selection button
if CurPage.SelectButton=nil then begin
CurBtn:=TSpeedButton.Create(nil);
CurPage.SelectButton:=CurBtn;
with CurBtn do begin
Name:='PaletteSelectBtn'+IntToStr(i);
OnClick := @SelectionToolClick;
Glyph.LoadFromLazarusResource('tmouse');
Flat := True;
GroupIndex:= 1;
Down := True;
Hint := lisSelectionTool;
SetBounds(ButtonX,0,ComponentPaletteBtnWidth,ComponentPaletteBtnHeight);
Parent:=CurNoteBookPage;
end; end;
end else if CurComponent.Button<>nil then begin
//writeln('TComponentPalette.UpdateNoteBookButtons Destroy Button: ',CurComponent.ComponentClass.ClassName,' ',CurComponent.Button.Name);
CurComponent.Button.Free;
CurComponent.Button:=nil;
end; end;
inc(ButtonX,ComponentPaletteBtnWidth+2); inc(ButtonX,((ComponentPaletteBtnWidth*3) div 2)+2);
// create component buttons
for j:=0 to CurPage.Count-1 do begin
CurComponent:=TPkgComponent(CurPage[j]);
if CurComponent.Visible then begin
if CurComponent.Button=nil then begin
CurBtn:=TSpeedButton.Create(nil);
CurComponent.Button:=CurBtn;
CreatePopupMenu;
with CurBtn do begin
Name:='PaletteBtnPage'+IntToStr(i)+'_'+IntToStr(j)
+'_'+CurComponent.ComponentClass.ClassName;
SetBounds(ButtonX,0,ComponentPaletteBtnWidth,ComponentPaletteBtnHeight);
Glyph := CurComponent.Icon;
GroupIndex := 1;
Flat := true;
OnClick := @ComponentBtnClick;
OnDblClick := @ComponentBtnDblClick;
Hint := CurComponent.ComponentClass.ClassName;
CurBtn.PopupMenu:=Self.PopupMenu;
Parent := CurNoteBookPage;
end;
//writeln('TComponentPalette.UpdateNoteBookButtons Created Button: ',CurComponent.ComponentClass.ClassName,' ',CurComponent.Button.Name);
end;
end else if CurComponent.Button<>nil then begin
//writeln('TComponentPalette.UpdateNoteBookButtons Destroy Button: ',CurComponent.ComponentClass.ClassName,' ',CurComponent.Button.Name);
CurComponent.Button.Free;
CurComponent.Button:=nil;
end;
inc(ButtonX,ComponentPaletteBtnWidth+2);
end;
end; end;
// restore active page
if (OldActivePage<>'') and (FNoteBook.Pages.IndexOf(OldActivePage)>=0) then
begin
FNoteBook.ActivePage:=OldActivePage;
end else if FNoteBook.PageCount>0 then begin
FNoteBook.PageIndex:=0;
end;
finally
// unlock
fUpdatingNotebook:=false;
fNoteBookNeedsUpdate:=false;
FNoteBook.EnableAlign;
end; end;
// restore active page
if (OldActivePage<>'') and (FNoteBook.Pages.IndexOf(OldActivePage)>=0) then
begin
FNoteBook.ActivePage:=OldActivePage;
end else if FNoteBook.PageCount>0 then begin
FNoteBook.PageIndex:=0;
end;
// unlock
fUpdatingNotebook:=false;
fNoteBookNeedsUpdate:=false;
//writeln('TComponentPalette.UpdateNoteBookButtons END'); //writeln('TComponentPalette.UpdateNoteBookButtons END');
end; end;

3
ide/lazarus.lpi
View File

@ -14,7 +14,6 @@
<IconPath Value="./"/> <IconPath Value="./"/>
<TargetFileExt Value=""/> <TargetFileExt Value=""/>
</General> </General>
<LazDoc Paths=""/>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
@ -40,7 +39,7 @@
<Filename Value="../lazarus"/> <Filename Value="../lazarus"/>
</Target> </Target>
<SearchPaths> <SearchPaths>
<UnitOutputDirectory Value="$(LazarusDir)/units/$(TargetCPU)-$(TargetOS)/"/> <UnitOutputDirectory Value="$(LazarusDir)/units/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<CodeGeneration> <CodeGeneration>
<Generate Value="Faster"/> <Generate Value="Faster"/>

2
ide/main.pp
View File

@ -2742,7 +2742,7 @@ Begin
OnCloseQuery:=@OnDesignerCloseQuery; OnCloseQuery:=@OnDesignerCloseQuery;
OnPersistentDeleted:=@OnDesignerPersistentDeleted; OnPersistentDeleted:=@OnDesignerPersistentDeleted;
OnGetNonVisualCompIcon:= OnGetNonVisualCompIcon:=
@TComponentPalette(IDEComponentPalette).OnGetNonVisualCompIcon; @TComponentPalette(IDEComponentPalette).OnGetNonVisualCompIcon;
OnGetSelectedComponentClass:=@OnDesignerGetSelectedComponentClass; OnGetSelectedComponentClass:=@OnDesignerGetSelectedComponentClass;
OnModified:=@OnDesignerModified; OnModified:=@OnDesignerModified;
OnPasteComponent:=@OnDesignerPasteComponent; OnPasteComponent:=@OnDesignerPasteComponent;

28
lcl/include/buttonglyph.inc
View File

@ -26,37 +26,29 @@ begin
FOriginal.OnChange := @GlyphChanged; FOriginal.OnChange := @GlyphChanged;
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------
{ TButtonGlyph destructor } TButtonGlyph destructor
{------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
destructor TButtonGlyph.Destroy; destructor TButtonGlyph.Destroy;
Begin begin
FOriginal.Free; FOriginal.Free;
FOriginal:=nil; FOriginal:=nil;
inherited Destroy; inherited Destroy;
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------
{ TButtonGlyph SetGlyph } TButtonGlyph SetGlyph
{------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TButtonGlyph.SetGlyph(Value : TBitmap); procedure TButtonGlyph.SetGlyph(Value : TBitmap);
var var
GlyphCount : integer; GlyphCount : integer;
begin begin
if FOriginal = Value then exit; if FOriginal = Value then exit;
{$IFDEF BitmapSharingWorks}
if FOriginal=nil then begin if FOriginal=nil then begin
FOriginal:=TBitmap.Create; FOriginal:=TBitmap.Create;
end; end;
FOriginal.OnChange:=nil; FOriginal.OnChange:=nil;
FOriginal.Assign(Value); FOriginal.Assign(Value);
{$ELSE}
if FOriginal<>nil then begin
FOriginal.OnChange:=nil;
FOriginal.Free;
end;
FOriginal:= Value;
{$ENDIF}
FOriginal.OnChange := @GlyphChanged; FOriginal.OnChange := @GlyphChanged;
FNumGlyphs:=1; FNumGlyphs:=1;
if (FOriginal <> nil) and (FOriginal.Height > 0) then begin if (FOriginal <> nil) and (FOriginal.Height > 0) then begin
@ -75,9 +67,9 @@ begin
if Assigned(FOnChange) then FOnChange(Self); if Assigned(FOnChange) then FOnChange(Self);
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------
{ TButtonGlyph Draw } TButtonGlyph Draw
{------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
Function TButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect; Function TButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
const Offset: TPoint; State: TButtonState; Transparent: Boolean; const Offset: TPoint; State: TButtonState; Transparent: Boolean;
BiDiFlags: Longint): TRect; BiDiFlags: Longint): TRect;

12
lcl/interfaces/gtk/gtkdef.pp
View File

@ -380,8 +380,8 @@ const
GDKX_KEY_LaunchF = $1008FF4F; GDKX_KEY_LaunchF = $1008FF4F;
function NewPGDIObject: PGDIObject; function InternalNewPGDIObject: PGDIObject;
procedure DisposePGDIObject(GDIObject: PGdiObject); procedure InternalDisposePGDIObject(GDIObject: PGdiObject);
function NewDeviceContext: TDeviceContext; function NewDeviceContext: TDeviceContext;
procedure DisposeDeviceContext(DeviceContext: TDeviceContext); procedure DisposeDeviceContext(DeviceContext: TDeviceContext);
@ -393,6 +393,9 @@ var
DebugDeviceContexts: TDebugLCLItems = nil; DebugDeviceContexts: TDebugLCLItems = nil;
{$ENDIF} {$ENDIF}
procedure GtkDefDone;
implementation implementation
@ -411,7 +414,7 @@ type
const const
GDIObjectMemManager: TGDIObjectMemManager = nil; GDIObjectMemManager: TGDIObjectMemManager = nil;
function NewPGDIObject: PGDIObject; function InternalNewPGDIObject: PGDIObject;
begin begin
if GDIObjectMemManager=nil then begin if GDIObjectMemManager=nil then begin
GDIObjectMemManager:=TGDIObjectMemManager.Create; GDIObjectMemManager:=TGDIObjectMemManager.Create;
@ -423,7 +426,7 @@ begin
{$ENDIF} {$ENDIF}
end; end;
procedure DisposePGDIObject(GDIObject: PGdiObject); procedure InternalDisposePGDIObject(GDIObject: PGdiObject);
begin begin
{$IFDEF DebugLCLComponents} {$IFDEF DebugLCLComponents}
DebugGdiObjects.MarkDestroyed(GDIObject); DebugGdiObjects.MarkDestroyed(GDIObject);
@ -605,7 +608,6 @@ begin
DCFlags:=[]; DCFlags:=[];
end; end;
procedure GtkDefInit; procedure GtkDefInit;
begin begin
{$IFDEF DebugLCLComponents} {$IFDEF DebugLCLComponents}

21
lcl/interfaces/gtk/gtklistsl.inc
View File

@ -437,6 +437,20 @@ var
i: integer; i: integer;
begin begin
if not (glsItemCacheNeedsUpdate in FStates) then exit; if not (glsItemCacheNeedsUpdate in FStates) then exit;
{$IFDEF DebugLCLComponents}
// if items were removed => mark them as destroyed
for i:=0 to FCachedCount-1 do begin
if (FGtkList=nil)
or (g_list_find(FGtkList^.children,FCachedItems[i])=nil) then begin
if DebugGtkWidgets.IsCreated(FCachedItems[i]) then begin
DebugLn(['TGtkListStringList.UpdateItemCache item vanished: ',i]);
DebugGtkWidgets.MarkDestroyed(FCachedItems[i]);
end;
end;
end;
{$ENDIF}
if (FGtkList<>nil) and (FGtkList^.children<>nil) then if (FGtkList<>nil) and (FGtkList^.children<>nil) then
FCachedCount:=g_list_length(FGtkList^.children) FCachedCount:=g_list_length(FGtkList^.children)
else else
@ -455,6 +469,13 @@ begin
i:=0; i:=0;
while CurListItem<>nil do begin while CurListItem<>nil do begin
FCachedItems[i]:=PGtkListItem(CurListItem^.Data); FCachedItems[i]:=PGtkListItem(CurListItem^.Data);
{$IFDEF DebugLCLComponents}
if not DebugGtkWidgets.IsCreated(PGtkListItem(CurListItem^.Data)) then
begin
DebugLn(['TGtkListStringList.UpdateItemCache unknown item ',i,' ',DbgSName(Owner)]);
DumpStack;
end;
{$ENDIF}
inc(i); inc(i);
CurListItem:=CurListItem^.Next; CurListItem:=CurListItem^.Next;
end; end;

21
lcl/interfaces/gtk/gtkobject.inc
View File

@ -515,6 +515,8 @@ begin
FKeyStateList_.Free; FKeyStateList_.Free;
{$ENDIF} {$ENDIF}
FTimerData.Free; FTimerData.Free;
GtkDefDone;
// finally remove our loghandler // finally remove our loghandler
g_log_remove_handler(nil, FLogHandlerID); g_log_remove_handler(nil, FLogHandlerID);
@ -4230,6 +4232,7 @@ begin
FFixWidgetsResized.Remove(FixWidget); FFixWidgetsResized.Remove(FixWidget);
// destroy the widget // destroy the widget
//DebugLn(['TGtkWidgetSet.DestroyConnectedWidget ',GetWidgetDebugReport(Widget)]);
DestroyWidget(Widget); DestroyWidget(Widget);
// remove all remaining messages to this widget // remove all remaining messages to this widget
@ -6103,16 +6106,8 @@ begin
if Result then if Result then
with PGdiObject(GDIObject)^ do with PGdiObject(GDIObject)^ do
case GDIType of case GDIType of
gdiBitmap : begin gdiBitmap : Result:=true;
case GDIBitmapType of gdiBrush : Result := True;
gbPixmap: Result := GDIPixmapObject <> nil;
gbBitmap: Result := GDIBitmapObject <> nil;
{obsolete: gbImage: Result := GDI_RGBImageObject <> nil;}
else
Result := False;
end;
end;
gdiBrush : Result := True; //Result := GDIBrushPixmap <> nil; //GDIBrushPixmap may be nil
gdiFont : Result := GDIFontObject <> nil;// ToDo: create font on demand gdiFont : Result := GDIFontObject <> nil;// ToDo: create font on demand
gdiPen : Result := True; gdiPen : Result := True;
gdiRegion : Result := True; gdiRegion : Result := True;
@ -6252,7 +6247,7 @@ end;
function TGtkWidgetSet.NewDC: TDeviceContext; function TGtkWidgetSet.NewDC: TDeviceContext;
begin begin
Assert(False, Format('Trace:> [TGtkWidgetSet.NewDC]', [])); Assert(False, Format('Trace:> [TGtkWidgetSet.NewDC]', []));
Result:=GtkDef.NewDeviceContext; Result:=NewDeviceContext;
with Result do with Result do
begin begin
{$ifdef TraceGdiCalls} {$ifdef TraceGdiCalls}
@ -6488,7 +6483,7 @@ end;
function TGtkWidgetSet.NewGDIObject(const GDIType: TGDIType): PGdiObject; function TGtkWidgetSet.NewGDIObject(const GDIType: TGDIType): PGdiObject;
begin begin
Assert(False, Format('Trace:> [TGtkWidgetSet.NewGDIObject]', [])); Assert(False, Format('Trace:> [TGtkWidgetSet.NewGDIObject]', []));
Result:=GtkDef.NewPGDIObject; Result:=GtkDef.InternalNewPGDIObject;
{$ifdef TraceGdiCalls} {$ifdef TraceGdiCalls}
FillStackAddrs(get_caller_frame(get_frame), @Result^.StackAddrs); FillStackAddrs(get_caller_frame(get_frame), @Result^.StackAddrs);
{$endif} {$endif}
@ -6511,7 +6506,7 @@ begin
if FGDIObjects.Contains(GDIObject) then begin if FGDIObjects.Contains(GDIObject) then begin
dec(GDIObject^.RefCount); dec(GDIObject^.RefCount);
FGDIObjects.Remove(GDIObject); FGDIObjects.Remove(GDIObject);
GtkDef.DisposePGDIObject(GDIObject); GtkDef.InternalDisposePGDIObject(GDIObject);
end else end else
RaiseGDBException(''); RaiseGDBException('');
end; end;

56
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -4990,8 +4990,10 @@ begin
then begin then begin
Widget := Window^.focus_widget; Widget := Window^.focus_widget;
{$IFDEF DebugLCLComponents} {$IFDEF DebugLCLComponents}
if DebugGtkWidgets.IsDestroyed(Widget) then if DebugGtkWidgets.IsDestroyed(Widget) then begin
DebugLn('TGtkWidgetSet.GetFocus ',DebugGtkWidgets.GetInfo(Widget,true)); DebugLn(['TGtkWidgetSet.GetFocus Window^.focus_widget was laready destroyed:']);
DebugLn(DebugGtkWidgets.GetInfo(Widget,true));
end;
{$ENDIF} {$ENDIF}
if (Widget <> nil) and gtk_widget_has_focus(Widget) if (Widget <> nil) and gtk_widget_has_focus(Widget)
@ -7901,8 +7903,20 @@ function TGtkWidgetSet.SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ;
begin begin
DebugLn(['TGtkWidgetSet.SelectObject DC=',dbghex(DC),' IsValidDC(DC)=',IsValidDC(DC),' GDIObj=',dbghex(GDIObj),' IsValidGDIObject(GDIObj)=',IsValidGDIObject(GDIObj)]); DebugLn(['TGtkWidgetSet.SelectObject DC=',dbghex(DC),' IsValidDC(DC)=',IsValidDC(DC),' GDIObj=',dbghex(GDIObj),' IsValidGDIObject(GDIObj)=',IsValidGDIObject(GDIObj)]);
DumpStack; DumpStack;
{$IFDEF DebugLCLComponents}
if not IsValidDC(DC) then begin
DebugLn(['DebugInvalidGDIObject DC:']);
debugln(DebugDeviceContexts.GetInfo(Pointer(DC),true));
end;
if not IsValidGDIObject(GDIObj) then begin
DebugLn(['DebugInvalidGDIObject GDIObj:']);
debugln(DebugGdiObjects.GetInfo(Pointer(GDIObj),true));
end;
{$ENDIF}
end; end;
var
NewDrawable: PGdkPixmap;
begin begin
Result := 0; Result := 0;
@ -7922,28 +7936,36 @@ begin
with TDeviceContext(DC) do with TDeviceContext(DC) do
begin begin
Assert(False, Format('trace: [TGtkWidgetSet.SelectObject] DC: 0x%x, Type: Bitmap', [DC])); Assert(False, Format('trace: [TGtkWidgetSet.SelectObject] DC: 0x%x, Type: Bitmap', [DC]));
if CurrentBitmap=nil then begin
// creating HBitmap on the fly (To find mem leaks)
CurrentBitmap:=NewGDIObject(gdiBitmap);
end;
Result := HBITMAP(CurrentBitmap); Result := HBITMAP(CurrentBitmap);
if CurrentBitmap<>PGDIObject(GDIObj) then begin if CurrentBitmap<>PGDIObject(GDIObj) then begin
CurrentBitmap := PGDIObject(GDIObj); CurrentBitmap := PGDIObject(GDIObj);
if GC <> nil then begin
gdk_gc_unref(GC);
GC:=nil;
end;
with CurrentBitmap^ do with CurrentBitmap^ do
case GDIBitmapType of case GDIBitmapType of
gbPixmap: Drawable := GDIPixmapObject; gbPixmap: NewDrawable := GDIPixmapObject;
gbBitmap: Drawable := GDIBitmapObject; gbBitmap: NewDrawable := GDIBitmapObject;
{obsolete: gbImage: Drawable := nil;//GDI_RGBImageObject;}
else else
Drawable := nil; NewDrawable := nil;
end; end;
//DebugLn('TGtkWidgetSet.SelectObject DC=',DbgS(DC),8),' GDIBitmap=',DbgS(Cardinal(CurrentBitmap), if NewDrawable<>nil then begin
//' GDIBitmapType=',ord(CurrentBitmap^.GDIBitmapType),' Drawable=',DbgS(Drawable)); //DebugLn('TGtkWidgetSet.SelectObject DC=',DbgS(DC),8),' GDIBitmap=',DbgS(Cardinal(CurrentBitmap),
//' GDIBitmapType=',ord(CurrentBitmap^.GDIBitmapType),' Drawable=',DbgS(Drawable));
GC := gdk_gc_new(Drawable); if GC <> nil then begin
gdk_gc_unref(GC);
gdk_gc_set_function(GC, GDK_COPY); GC:=nil;
SelectedColors := dcscCustom; end;
Drawable:=NewDrawable;
GC := gdk_gc_new(Drawable);
gdk_gc_set_function(GC, GDK_COPY);
SelectedColors := dcscCustom;
end else begin
// use defaults, free dummy gdiobject
DisposeGDIObject(CurrentBitmap);
CurrentBitmap:=nil;
end;
end; end;
end; end;

3
lcl/interfaces/gtk/gtkwsbuttons.pp
View File

@ -130,6 +130,9 @@ begin
Result := TLCLIntfHandle(gtk_button_new_with_label('button')); Result := TLCLIntfHandle(gtk_button_new_with_label('button'));
if Result = 0 then Exit; if Result = 0 then Exit;
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Pointer(Result),'button');
{$ENDIF}
WidgetInfo := CreateWidgetInfo(Pointer(Result), Button, AParams); WidgetInfo := CreateWidgetInfo(Pointer(Result), Button, AParams);

28
lcl/lclproc.pas
View File

@ -91,6 +91,7 @@ type
function FindInfo(p: Pointer; CreateIfNotExists: boolean = false function FindInfo(p: Pointer; CreateIfNotExists: boolean = false
): TDebugLCLItemInfo; ): TDebugLCLItemInfo;
function IsDestroyed(p: Pointer): boolean; function IsDestroyed(p: Pointer): boolean;
function IsCreated(p: Pointer): boolean;
function MarkCreated(p: Pointer; const InfoText: string): TDebugLCLItemInfo; function MarkCreated(p: Pointer; const InfoText: string): TDebugLCLItemInfo;
procedure MarkDestroyed(p: Pointer); procedure MarkDestroyed(p: Pointer);
function GetInfo(p: Pointer; WithStackTraces: boolean): string; function GetInfo(p: Pointer; WithStackTraces: boolean): string;
@ -2393,27 +2394,31 @@ begin
end; end;
end; end;
function UTF8CStringToUTF8String(SourceStart: PChar; SourceLen: SizeInt) : string; function UTF8CStringToUTF8String(SourceStart: PChar; SourceLen: SizeInt) : string;
var var
Source: PChar; Source: PChar;
Dest: PChar; Dest: PChar;
SourceEnd: PChar; SourceEnd: PChar;
CharLen: integer; CharLen: integer;
SourceCopied: PChar;
// Copies from SourceStart till Source to Dest and updates Dest // Copies from SourceStart till Source to Dest and updates Dest
procedure CopyPart; inline; procedure CopyPart; inline;
var var
CopyLength: SizeInt; CopyLength: SizeInt;
begin begin
CopyLength := Source - SourceStart; CopyLength := Source - SourceCopied;
if CopyLength=0 then exit; if CopyLength=0 then exit;
move(SourceStart^ , Dest^, CopyLength); move(SourceCopied^ , Dest^, CopyLength);
SourceCopied:=Source;
inc(Dest, CopyLength); inc(Dest, CopyLength);
end; end;
begin begin
Source:= SourceStart;
SetLength(Result, SourceLen); SetLength(Result, SourceLen);
if SourceLen=0 then exit;
SourceCopied:=SourceStart;
Source:=SourceStart;
Dest:=PChar(Result); Dest:=PChar(Result);
SourceEnd := Source + SourceLen; SourceEnd := Source + SourceLen;
while Source<SourceEnd do begin while Source<SourceEnd do begin
@ -2442,7 +2447,7 @@ begin
inc(Source); inc(Source);
inc(Dest); inc(Dest);
end; end;
SourceStart := Source; SourceCopied := Source;
end end
else else
Inc(Source, CharLen); Inc(Source, CharLen);
@ -2993,6 +2998,17 @@ begin
Result:=Info.IsDestroyed; Result:=Info.IsDestroyed;
end; end;
function TDebugLCLItems.IsCreated(p: Pointer): boolean;
var
Info: TDebugLCLItemInfo;
begin
Info:=FindInfo(p);
if Info=nil then
Result:=false
else
Result:=not Info.IsDestroyed;
end;
procedure TDebugLCLItems.MarkDestroyed(p: Pointer); procedure TDebugLCLItems.MarkDestroyed(p: Pointer);
var var
Info: TDebugLCLItemInfo; Info: TDebugLCLItemInfo;
@ -3041,7 +3057,7 @@ var
procedure RaiseDoubleCreated; procedure RaiseDoubleCreated;
begin begin
debugLn('TDebugLCLItems.MarkCreated old:'); debugLn('TDebugLCLItems.MarkCreated CREATED TWICE. Old:');
debugln(Info.AsString(true)); debugln(Info.AsString(true));
debugln(' New=',dbgs(p),' InfoText="',InfoText,'"'); debugln(' New=',dbgs(p),' InfoText="',InfoText,'"');
DebugLn(GetStackTrace(true)); DebugLn(GetStackTrace(true));

6
packager/packagedefs.pas
View File

@ -3120,7 +3120,11 @@ end;
destructor TPkgComponent.Destroy; destructor TPkgComponent.Destroy;
begin begin
PkgFile:=nil; PkgFile:=nil;
if fIconLoaded then FIcon.Free; if fIconLoaded then begin
FIcon.Free;
FIcon:=nil;
fIconLoaded:=false;
end;
inherited Destroy; inherited Destroy;
end; end;

16
tools/install/cross_unix/HowToCreate_fpc_crosswin32_rpm.txt
View File

@ -2,13 +2,17 @@ How to create the fpc_crosswin32 rpm
This rpm was only tested under linux. This rpm was only tested under linux.
First get the FPC sources. For configuration see below.
First get the FPC sources and the binutils.
For example: For example:
[]$ cd <lazarusdir>/tools/install/cross_unix/ []$ cd <lazarusdir>/tools/install/cross_unix/
[]$ ./build_linux_cross_win32_rpm.sh downloadbinutils downloadfpc buildbinutils []$ ./build_linux_cross_win32_rpm.sh downloadbinutils downloadfpc buildbinutils
This will download the FPC svn to ~/freepascal/fpc. This will download the FPC svn to ~/freepascal/fpc, its install files to
~/freepascal/install and the binutils to ~/freepascal/binutils.
Create the fpc rpm and install it: Create the fpc rpm and install it:
@ -21,3 +25,11 @@ Then build the fpc_crosswin32 rpm and install it:
[]$ sudo rpm -Uvh <path_to_rpms>/RPMS/i386/fpc_crosswin32-<version>.i386.rpm []$ sudo rpm -Uvh <path_to_rpms>/RPMS/i386/fpc_crosswin32-<version>.i386.rpm
Now you can cross compile from linux to win32. Now you can cross compile from linux to win32.
================================================================================
The following environment variables are handled:
The base directory BuildRoot. Default value is ~/freepascal
[]$ export BuildRoot=/home/user/freepascal

4
tools/install/cross_unix/build_linux_cross_win32_rpm.sh
View File

@ -7,7 +7,9 @@ set -e
#set -x #set -x
# This is the root for all download and building directories # This is the root for all download and building directories
BuildRoot=~/freepascal if [ ! -d "$BuildRoot" ]; then
BuildRoot=~/freepascal
fi
#=============================================================================== #===============================================================================
# parse command line parameters # parse command line parameters

4
tools/install/cross_unix/update_cross_fpc.sh
View File

@ -7,7 +7,9 @@ set -e
set -x set -x
# This is the root for all download and building directories # This is the root for all download and building directories
BuildRoot=~/freepascal if [ ! -d "$BuildRoot" ]; then
BuildRoot=~/freepascal
fi
# the binutils version to download # the binutils version to download
BinutilsVersion=2.16 BinutilsVersion=2.16