* Added a X11 only utility app that highlights the window sizes used by widgets in any applications. This will get extended over time to include more window information.

2 files changed, 439 insertions, 0 deletions

diff --git a/extras/x11_wininfo/x11wininfo.lpi b/extras/x11_wininfo/x11wininfo.lpi
new file mode 100644
index 00000000..0096dd7b
--- /dev/null
+++ b/extras/x11_wininfo/x11wininfo.lpi
@@ -0,0 +1,56 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="6"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=""/>
+      <Title Value="x11wininfo"/>
+      <UseAppBundle Value="False"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="fpgui_toolkit"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="x11wininfo.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="x11wininfo"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="8"/>
+    <Parsing>
+      <SyntaxOptions>
+        <CStyleOperator Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <CustomOptions Value="-FUunits"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>
diff --git a/extras/x11_wininfo/x11wininfo.lpr b/extras/x11_wininfo/x11wininfo.lpr
new file mode 100644
index 00000000..39e0eae4
--- /dev/null
+++ b/extras/x11_wininfo/x11wininfo.lpr
@@ -0,0 +1,383 @@
+program x11wininfo;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, SysUtils, fpg_base, fpg_main, fpg_form, fpg_label, fpg_panel,
+  fpg_button, fpg_listbox, fpg_impl, fpg_tab, fpg_edit, fpg_x11,
+  xlib, x;
+
+type
+  TMainForm = class(TfpgForm)
+  private
+    {@VFD_HEAD_BEGIN: MainForm}
+    Button1: TfpgButton;
+    PageControl1: TfpgPageControl;
+    TabSheet1: TfpgTabSheet;
+    Edit1: TfpgEdit;
+    Edit2: TfpgEdit;
+    Label1: TfpgLabel;
+    lblPos: TfpgLabel;
+    Label3: TfpgLabel;
+    lblSize: TfpgLabel;
+    Label2: TfpgLabel;
+    lblHandle: TfpgLabel;
+    Bevel1: TfpgBevel;
+    Label4: TfpgLabel;
+    {@VFD_HEAD_END: MainForm}
+    FTimer: TfpgTimer;
+    FOutlineGC: TfpgGContext;
+    FOutlineDrawn: Boolean;
+    newrect: TfpgRect;
+    lastRect: TfpgRect;
+    last_child: TfpgWinHandle;
+    procedure btnWinInfoClicked(Sender: TObject);
+    procedure TimerFired(Sender: TObject);
+    procedure InitOutline;
+    procedure DrawOutline;
+    procedure ClearOutine;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure AfterCreate; override;
+  end;
+
+{ TMainForm }
+
+procedure TMainForm.btnWinInfoClicked(Sender: TObject);
+begin
+  FTimer.Enabled := not FTimer.Enabled;
+  ClearOutine;
+end;
+
+procedure TMainForm.TimerFired(Sender: TObject);
+type
+   AChildren = array[0..0] of TfpgWinHandle;
+   PChildren = ^AChildren;
+var
+  rootw: TfpgWinHandle;
+  parentw: TfpgWinHandle;
+  children: PChildren;
+  cnum: longword;
+  ret_root: TfpgWinHandle;
+  ret_child: TfpgWinHandle;
+  root_x, root_y: integer;
+  child_x, child_y: integer;
+  mask: longword;
+  x: integer;
+  winrect: TfpgRect;
+  wa: TXWindowAttributes;
+begin
+  rootw := DefaultRootWindow(fpgApplication.Display);
+
+  x := 1;
+  XQueryPointer(fpgApplication.Display, rootw, @ret_root, @ret_child,
+      @root_x, @root_y, @child_x, @child_y, @mask);
+
+  while ret_child <> 0 do
+  begin
+    last_child := ret_child;
+    if XQueryPointer(fpgApplication.Display, ret_child, @ret_root, @ret_child,
+        @root_x, @root_y, @child_x, @child_y, @mask) then
+    begin
+//      writeln('X=', x);
+      Inc(x);
+//      writeln('Button.WinHandle: ', IntToHex(Button1.WinHandle, 6));
+//      writeln('WinHandle under pointer: ', IntToHex(ret_child, 6));
+    end;
+  end;
+  XGetWindowAttributes(fpgApplication.Display, last_child, @wa);
+  winrect.SetRect(wa.x, wa.y, wa.width, wa.height);
+//  writeln('----start----');
+//  PrintRect(winrect);
+
+  XTranslateCoordinates(fpgApplication.Display,
+      last_child, DefaultRootWindow(fpgApplication.Display),
+      wa.X, wa.Y, @root_x, @root_y, @ret_child);
+
+  newrect.SetRect(root_x-wa.X, root_y-wa.Y, wa.width, wa.height);
+//  PrintRect(newrect);
+//  writeln('----done----');
+  ClearOutine;
+  DrawOutline;
+
+
+  exit; //==>
+  children := nil;
+  if XQueryTree(
+      fpgApplication.Display,
+      DefaultRootWindow(fpgApplication.Display),
+      @rootw, @parentw, @children, @cnum) <> 0 then
+  begin
+
+  end;
+  if children <> nil then
+    XFree(children);
+end;
+
+procedure TMainForm.InitOutline;
+var
+  gcValues: TXGCValues;
+begin
+   gcValues._function := GXxor; //GXinvert;
+   gcValues.subwindow_mode := IncludeInferiors;
+   gcValues.line_width := 2;
+   FOutlineGC := XCreateGC(
+      fpgApplication.Display,
+      DefaultRootWindow(fpgApplication.Display),
+      GCFunction or GCSubwindowMode or GCLineWidth, @gcValues);
+   XSetForeGround(fpgApplication.display, FOutlineGC, fpgColorToX(clRed));
+  FOutlineDrawn := False;
+end;
+
+procedure TMainForm.DrawOutline;
+begin
+  if not FOutlineDrawn then
+  begin
+    XSync(fpgApplication.Display, False);
+    XDrawRectangle(
+        fpgApplication.Display,
+        DefaultRootWindow(fpgApplication.Display),
+        FOutlineGC,
+        newrect.Left, newrect.Top, newrect.Width, newrect.Height);
+    lastrect := newrect;
+    FOutlineDrawn := True;
+    lblPos.Text := Format('(%d,%d)', [newrect.Left, newRect.Top]);
+    lblSize.Text := Format('(%d,%d)', [newrect.Width, newRect.Height]);
+    lblHandle.Text := IntToHex(last_child, 6);
+  end;
+end;
+
+procedure TMainForm.ClearOutine;
+begin
+  if FOutlineDrawn then
+  begin
+    XDrawRectangle(
+        fpgApplication.Display,
+        DefaultRootWindow(fpgApplication.Display),
+        FOutlineGC,
+        lastrect.Left, lastrect.Top, lastrect.Width, lastrect.Height);
+    FOutlineDrawn := False;
+    XSync(fpgApplication.Display, False);
+  end;
+end;
+
+constructor TMainForm.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FTimer := TfpgTimer.Create(80);
+  FTimer.OnTimer := @TimerFired;
+  InitOutline;
+end;
+
+destructor TMainForm.Destroy;
+begin
+  ClearOutine;
+  XFreeGC(fpgApplication.Display, FOutlineGC);
+  inherited Destroy;
+end;
+
+procedure TMainForm.AfterCreate;
+begin
+  {@VFD_BODY_BEGIN: MainForm}
+  Name := 'MainForm';
+  SetPosition(334, 226, 300, 309);
+  WindowTitle := 'fpGUI Window Information';
+  WindowPosition := wpUser;
+
+  Button1 := TfpgButton.Create(self);
+  with Button1 do
+  begin
+    Name := 'Button1';
+    SetPosition(208, 8, 80, 24);
+    Text := 'wininfo';
+    AllowAllUp := False;
+    Embedded := False;
+    Flat := False;
+    FontDesc := '#Label1';
+    GroupIndex := 0;
+    Hint := '';
+    ImageLayout := ilImageLeft;
+    ImageMargin := 3;
+    ImageName := '';
+    ImageSpacing := -1;
+    ModalResult := 0;
+    ParentShowHint := True;
+    ShowImage := True;
+    TabOrder := 0;
+    OnClick :=@btnWinInfoClicked;
+  end;
+
+  PageControl1 := TfpgPageControl.Create(self);
+  with PageControl1 do
+  begin
+    Name := 'PageControl1';
+    SetPosition(16, 172, 274, 116);
+    ActivePageIndex := 0;
+    ParentShowHint := True;
+    TabOrder := 3;
+  end;
+
+  TabSheet1 := TfpgTabSheet.Create(PageControl1);
+  with TabSheet1 do
+  begin
+    Name := 'TabSheet1';
+    SetPosition(3, 24, 268, 89);
+    Text := 'TabSheet1';
+  end;
+
+  Edit1 := TfpgEdit.Create(TabSheet1);
+  with Edit1 do
+  begin
+    Name := 'Edit1';
+    SetPosition(140, 12, 120, 22);
+    TabOrder := 0;
+    Text := '';
+    FontDesc := '#Edit1';
+    ParentShowHint := True;
+  end;
+
+  Edit2 := TfpgEdit.Create(TabSheet1);
+  with Edit2 do
+  begin
+    Name := 'Edit2';
+    SetPosition(24, 52, 22, 22);
+    TabOrder := 1;
+    Text := '';
+    FontDesc := '#Edit1';
+    ParentShowHint := True;
+  end;
+
+  Label1 := TfpgLabel.Create(self);
+  with Label1 do
+  begin
+    Name := 'Label1';
+    SetPosition(12, 44, 68, 16);
+    Alignment := taLeftJustify;
+    FontDesc := '#Label2';
+    Hint := '';
+    Layout := tlTop;
+    ParentShowHint := True;
+    Text := 'Left, Top:';
+    WrapText := False;
+  end;
+
+  lblPos := TfpgLabel.Create(self);
+  with lblPos do
+  begin
+    Name := 'lblPos';
+    SetPosition(120, 44, 80, 16);
+    Alignment := taLeftJustify;
+    FontDesc := '#Label1';
+    Hint := '';
+    Layout := tlTop;
+    ParentShowHint := True;
+    Text := '-';
+    WrapText := False;
+  end;
+
+  Label3 := TfpgLabel.Create(self);
+  with Label3 do
+  begin
+    Name := 'Label3';
+    SetPosition(12, 68, 100, 16);
+    Alignment := taLeftJustify;
+    FontDesc := '#Label2';
+    Hint := '';
+    Layout := tlTop;
+    ParentShowHint := True;
+    Text := 'Width, Height:';
+    WrapText := False;
+  end;
+
+  lblSize := TfpgLabel.Create(self);
+  with lblSize do
+  begin
+    Name := 'lblSize';
+    SetPosition(120, 68, 80, 16);
+    Alignment := taLeftJustify;
+    FontDesc := '#Label1';
+    Hint := '';
+    Layout := tlTop;
+    ParentShowHint := True;
+    Text := '-';
+    WrapText := False;
+  end;
+
+  Label2 := TfpgLabel.Create(self);
+  with Label2 do
+  begin
+    Name := 'Label2';
+    SetPosition(12, 92, 80, 16);
+    Alignment := taLeftJustify;
+    FontDesc := '#Label2';
+    Hint := '';
+    Layout := tlTop;
+    ParentShowHint := True;
+    Text := 'Handle:';
+    WrapText := False;
+  end;
+
+  lblHandle := TfpgLabel.Create(self);
+  with lblHandle do
+  begin
+    Name := 'lblHandle';
+    SetPosition(120, 92, 80, 16);
+    Alignment := taLeftJustify;
+    FontDesc := '#Label1';
+    Hint := '';
+    Layout := tlTop;
+    ParentShowHint := True;
+    Text := '-';
+    WrapText := False;
+  end;
+
+  Bevel1 := TfpgBevel.Create(self);
+  with Bevel1 do
+  begin
+    Name := 'Bevel1';
+    SetPosition(24, 132, 248, 28);
+    BorderStyle := bsSingle;
+    ParentShowHint := True;
+    Style := bsRaised;
+  end;
+
+  Label4 := TfpgLabel.Create(self);
+  with Label4 do
+  begin
+    Name := 'Label4';
+    SetPosition(42, 137, 223, 16);
+    Alignment := taLeftJustify;
+    FontDesc := '#Label2';
+    Hint := '';
+    Layout := tlTop;
+    ParentShowHint := True;
+    Text := '===== Below is a test area =====';
+    WrapText := False;
+  end;
+
+  {@VFD_BODY_END: MainForm}
+end;
+
+
+procedure MainProc;
+var
+  frm: TMainForm;
+begin
+  fpgApplication.Initialize;
+  frm := TMainForm.Create(nil);
+  try
+    frm.Show;
+    fpgApplication.Run;
+  finally
+    frm.Free;
+  end;
+end;
+
+begin
+  MainProc;
+end.
+