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

LCL-GTK3: Prevent a range error in function ButtonClicked.

Browse Source 
git-svn-id: trunk@63844 -
This commit is contained in:
juha 2020-08-29 16:15:27 +00:00
parent bce7246f36
commit 49a3adfab7
2 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
lcl/interfaces/gtk3/gtk3boxes.pas
View File

@ -73,19 +73,24 @@ begin
ModalResult:= {%H-}PtrUInt(g_object_get_data(PGObject(Widget), 'modal_result'));
{ Don't allow to close if we don't have a default return value }
Result:= (ModalResult = 0);
if not Result then PInteger(data)^:= ModalResult
else DebugLn('Do not close !!!');
end else Result:= false;
if Result then
DebugLn('Do not close !!!')
else
PInteger(data)^:= Integer(ModalResult);
end else
Result:= false;
end;
function ButtonClicked(Widget : PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
ModalResult : PtrUInt;
begin
PInteger(data)^ := {%H-}PtrUInt(g_object_get_data(PGObject(Widget), 'modal_result'));
ModalResult := {%H-}PtrUInt(g_object_get_data(PGObject(Widget), 'modal_result'));
PInteger(data)^ := Integer(ModalResult);
Result := False;
end;
class function TGtk3DialogFactory.ResponseID(const AnID: Integer): Integer;
begin
case AnID of
@ -106,7 +111,6 @@ begin
end;
end;
class function TGtk3DialogFactory.gtk_resp_to_lcl(const gtk_resp:integer):integer;
begin
case gtk_resp of
@ -153,7 +157,6 @@ begin
end;
end;
procedure TGtk3DialogFactory.CreateButton(
const ALabel : String;
const AResponse: Integer;

1
lcl/interfaces/gtk3/gtk3private.pas
View File

@ -661,7 +661,6 @@ end;
procedure TGtkListStoreStringList.Insert(Index: Integer; const S: String);
var
li: TGtkTreeIter;
LCLIndex: PInteger;
begin
if (Index < 0) or (Index > Count)
then begin