unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WindowsData;

type
  TfrmWindowProp = class(TForm)
    cmbRefresh: TButton;
    cmbClose: TButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    txtClassName: TEdit;
    Label2: TLabel;
    txtWindowName: TEdit;
    Label3: TLabel;
    txtId: TEdit;
    GroupBox2: TGroupBox;
    lstStyle: TListBox;
    cmbDelStyle: TButton;
    cmbAddStyle: TButton;
    txtWindowRect: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    lstAvailStyle: TListBox;
    GroupBox3: TGroupBox;
    Label6: TLabel;
    lstExStyle: TListBox;
    cmbAddExStyle: TButton;
    cmbDelExStyle: TButton;
    lstAvailExStyle: TListBox;
    procedure cmbRefreshClick(Sender: TObject);
    procedure cmbCloseClick(Sender: TObject);
    procedure cmbDelStyleClick(Sender: TObject);
    procedure cmbAddStyleClick(Sender: TObject);
    procedure cmbDelExStyleClick(Sender: TObject);
    procedure cmbAddExStyleClick(Sender: TObject);
  private
    wnd: HWND;
    { Private declarations }
    procedure LoadWindowInfo();
    procedure LoadWindowStyle();
    function GetStyleIndex(listIndex: Integer; used: Boolean): Integer;
    procedure LoadWindowExStyle();
    function GetExStyleIndex(listIndex: Integer; used: Boolean): Integer;
  public
    { Public declarations }
    procedure ShowWindowProp(window: HWND);
  end;

var
  frmWindowProp: TfrmWindowProp;

implementation

{$R *.dfm}


procedure TfrmWindowProp.LoadWindowInfo();
var
  rect: TRect;
  buffer: String;
begin
  //Сбор сведений об окне
  //..имя класса
  SetLength(buffer, 1024);
  SetLength(buffer, GetClassName(wnd, PAnsiChar(buffer), 1024));
  txtClassName.Text := buffer;
  //..имя (заголовок) окна
  SetLength(buffer, SendMessage(wnd, WM_GETTEXTLENGTH, 0, 0) + 1);
  SendMessage(wnd, WM_GETTEXT, Length(buffer), Integer(PAnsiChar(buffer)));
  txtWindowName.Text := buffer;
  //..идентификатор (или дескриптор меню) окна
  txtId.Text := IntToStr(GetWindowLong(wnd, GWL_ID));
  //..оконный прямоугольник
  GetWindowRect(wnd, rect);
  txtWindowRect.Text :=
   '(' + IntToStr(rect.Left) + ',' + IntToStr(rect.Top) + ')' +
   ' - ' +
   '(' + IntToStr(rect.Right) + ',' + IntToStr(rect.Bottom) + ') ' +
   IntToStr(rect.Right-rect.Left) + 'x' + IntToStr(rect.Bottom - rect.Top);

  //Определение стиля окна
  LoadWindowStyle();
  LoadWindowExStyle();
end;

//Формирование списков используемых и неиспользуемых флагов
//стиля
procedure TfrmWindowProp.LoadWindowStyle();
var
  i: Integer;
  style: DWORD;
begin
  style := GetWindowLong(wnd, GWL_STYLE);
  lstStyle.Clear();
  lstAvailStyle.Clear();
  //Выделение из 32-битного значения составляющих стиля окна
  for i := 0 to 17 do
    if styles[i].value and style <> 0 then
    begin
      //Стиль используется
      lstStyle.Items.Add(styles[i].name);
      styles[i].used := True;
    end
    else
    begin
      //Стиль не используется
      lstAvailStyle.Items.Add(styles[i].name);
      styles[i].used := False;
    end;
end;

//Формирование списков используемых и неиспользуемых флагов расширенного
//стиля
procedure TfrmWindowProp.LoadWindowExStyle();
var
  i: Integer;
  exstyle: DWORD;
begin
  exstyle := GetWindowLong(wnd, GWL_EXSTYLE);
  lstExStyle.Clear();
  lstAvailExStyle.Clear();
  //Выделение из 32-битного значения составляющих стиля окна
  for i := 0 to 18 do
    if exstyles[i].value and exstyle <> 0 then
    begin
      //Стиль используется
      lstExStyle.Items.Add(exstyles[i].name);
      exstyles[i].used := True;
    end
    else
    begin
      //Стиль не используется
      lstAvailExStyle.Items.Add(exstyles[i].name);
      exstyles[i].used := False;
    end;
end;

procedure TfrmWindowProp.cmbRefreshClick(Sender: TObject);
begin
  LoadWindowInfo();
end;

//Этот метод вызывается для первоначального отображения
//формы свойств
procedure TfrmWindowProp.ShowWindowProp(window: HWND);
begin
  wnd := window;
  LoadWindowInfo();
  ShowModal(); //Не забываем показать сами себя
end;

procedure TfrmWindowProp.cmbCloseClick(Sender: TObject);
begin
  Close;
end;

//Определение номера элемента в массиве styles по номеру стиля
//в списке на форме
function TfrmWindowProp.GetStyleIndex(listIndex: Integer; used: Boolean)
                        :Integer;
var
  i, count: Integer;
begin
  count := 0;
  for i := 0 to 17 do
    if styles[i].used = used then
    begin
      if count = listIndex then
      begin
        //Нашли
        GetStyleIndex := i;
        Exit;
      end;
      Inc(count);
    end;
  GetStyleIndex := 0;
end;

//Определение номера элемента в массиве exstyles по номеру стиля
//в списке на форме
function TfrmWindowProp.GetExStyleIndex(listIndex: Integer; used: Boolean)
                        :Integer;
var
  i, count: Integer;
begin
  count := 0;
  for i := 0 to 17 do
    if exstyles[i].used = used then
    begin
      if count = listIndex then
      begin
        //Нашли
        GetExStyleIndex := i;
        Exit;
      end;
      Inc(count);
    end;
  GetExStyleIndex := 0;
end;

//Удаление стиля
procedure TfrmWindowProp.cmbDelStyleClick(Sender: TObject);
var
  style: DWORD;
  delstyle: DWORD;
begin
  if lstStyle.ItemIndex = -1 then Exit;
  //Удаление выбранного стиля окна
  //..определяем, какой стиль удалить
  delstyle := styles[GetStyleIndex(lstStyle.ItemIndex, True)].value;
  //..вычисляем и устанавливаем новое значение стиля окна
  style := GetWindowLong(wnd, GWL_STYLE);
  style := style and not delstyle;
  SetWindowLong(wnd, GWL_STYLE, style);
  //..перерисуем все окна
  InvalidateRect(0, nil, TRUE);
  //Обновим список стилей окна
  LoadWindowStyle();
end;

//Добавление стиля
procedure TfrmWindowProp.cmbAddStyleClick(Sender: TObject);
var
  style: DWORD;
  addstyle: DWORD;
begin
  if lstAvailStyle.ItemIndex = -1 then Exit;
  //Удаление выбранного стиля окна
  //..определяем, какой стиль удалить
  addstyle := styles[GetStyleIndex(lstAvailStyle.ItemIndex, False)].value;
  //..вычисляем и устанавливаем новое значение стиля окна
  style := GetWindowLong(wnd, GWL_STYLE);
  style := style or addstyle;
  SetWindowLong(wnd, GWL_STYLE, style);
  //..перерисуем все окна
  InvalidateRect(0, nil, TRUE);
  //Обновим список стилей окна
  LoadWindowStyle();
end;

//Удаление дополнительного стиля
procedure TfrmWindowProp.cmbDelExStyleClick(Sender: TObject);
var
  style: DWORD;
  delstyle: DWORD;
begin
  if lstExStyle.ItemIndex = -1 then Exit;
  //Удаление выбранного стиля окна
  //..определяем, какой стиль удалить
  delstyle := exstyles[GetExStyleIndex(lstExStyle.ItemIndex, True)].value;
  //..вычисляем и устанавливаем новое значение стиля окна
  style := GetWindowLong(wnd, GWL_EXSTYLE);
  style := style and not delstyle;
  SetWindowLong(wnd, GWL_EXSTYLE, style);
  //..перерисуем все окна
  InvalidateRect(0, nil, TRUE);
  //Обновим список стилей окна
  LoadWindowExStyle();
end;

//Добавление стиля
procedure TfrmWindowProp.cmbAddExStyleClick(Sender: TObject);
var
  style: DWORD;
  addstyle: DWORD;
begin
  if lstAvailExStyle.ItemIndex = -1 then Exit;
  //Удаление выбранного стиля окна
  //..определяем, какой стиль удалить
  addstyle := exstyles[GetExStyleIndex(lstAvailExStyle.ItemIndex, False)].value;
  //..вычисляем и устанавливаем новое значение стиля окна
  style := GetWindowLong(wnd, GWL_EXSTYLE);
  style := style or addstyle;
  SetWindowLong(wnd, GWL_EXSTYLE, style);
  //..перерисуем все окна
  InvalidateRect(0, nil, TRUE);
  //Обновим список стилей окна
  LoadWindowExStyle();
end;


end.
