path: root/extras/x11_wininfo/x11wininfo.lpr

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;
    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.