[Lazarus] GtkWidget questions

SteveG steveg at nevets.com.au
Sun Sep 14 02:16:29 CEST 2008


Mattias - following is the code (from a new project in Laz) I am using 
to test this

It is just a direct copy from the gtk code supplied with Laz/fpc (with 3 
lines added for testing) - and the result is being ignored
My form has a button (button1) and memo (memo1) - nothing else
The memo receives 'Test 1' and 'Test 2', never reaches 'Test 3' - fails 
with 'access violation'
With further testing of functions, I find that any call using a 
gdkwindow fails for me - so must be something simple somewhere

Using Laz ver 0.9.25 (svn 15686) on Ubuntu 804

unit Unit1;
{$mode objfpc}{$H+}
interface
uses Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, 
StdCtrls, gtk2, glib2, gdk2;

type

  { TForm1 }
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

function GetActiveWindow :integer;
var
  TopList, List: PGList;
  Widget: PGTKWidget;
  Window: PGTKWindow;
begin
  Result := 0;

  TopList := pglist(gdk_window_get_toplevels);
  List := TopList;

  while List <> nil do begin

    if (List^.Data <> nil) then begin
Form1.memo1.lines.add('TEST 1');

      gdk_window_get_user_data(PGDKWindow(List^.Data), Pgpointer(@Window));
Form1.memo1.lines.add('TEST 2');

      if gtk_is_window(Window) then begin
Form1.memo1.lines.add('TEST 3');

        Widget := Window^.focus_widget;

        if Widget=nil then Widget:=PGtkWidget(Window);

        if (Widget <> nil) and gtk_widget_has_focus(Widget) then begin
          Result := 1;//PtrUInt(GetMainWidget(PGtkWidget(Window)));
          Break;
        end;
      end;
    end;

    list := g_list_next(list);
  end;
  if TopList <> nil then g_list_free(TopList);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetActiveWindow();
end;

initialization
  {$I Unit1.lrs}
end.



Mattias Gaertner wrote:
> On Sun, 14 Sep 2008 00:33:33 +1000
> SteveG <steveg at nevets.com.au> wrote:
>
>   
>> Still fails at same point unfortunately
>>     
>
> Please give more details about failure and a more complete example.
>
> Mattias
>
>
>   




More information about the Lazarus mailing list