Stil der Aero TNA-Dialoge gesucht

[madtom]

Hallo Daniel,

ich habe mal einen Code von Peter Below (TeamB) leicht modifiziert, mit ihm lassen sich leicht anhand des Handle's die genutzten Window Styles inpezieren:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure Display(const S: string); overload;
    procedure Display(const Fmt: string; const A: array of const); overload;
    procedure ShowStyles(Style: DWORD);
    procedure ShowExStyles(Style: DWORD);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Display(const S: string);
begin
  Memo1.Lines.Add(S);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Wnd: HWND;
  Style: DWORD;
begin
  Memo1.Clear;
  Wnd := FindWindow('NotifyIconOverflowWindow', nil);
  // bei den Netzwerkverbindungen war nicht WS_THICKFRAME gesetzt
  Style := GetWindowLong(Wnd, GWL_STYLE);
  ShowStyles(Style);
  Style := GetWindowLong(Wnd, GWL_EXSTYLE);
  ShowExStyles(Style);
end;

procedure TForm1.Display(const Fmt: string; const A: array of const);
begin
  Display(Format(Fmt, A));
end;

type
  TStyleRec = record
    Name: string;
    Value: DWORD;
  end;

  TStyles = array [1 .. 27] of TStyleRec;
  TExStyles = array [1 .. 26] of TStyleRec;

const
  Styles: TStyles = (
    (Name: 'WS_BORDER'; Value: WS_BORDER),
    (Name: 'WS_CAPTION'; Value: WS_CAPTION),
    (Name: 'WS_CHILD'; Value: WS_CHILD),
    (Name: 'WS_CHILDWINDOW'; Value: WS_CHILDWINDOW),
    (Name: 'WS_CLIPCHILDREN'; Value: WS_CLIPCHILDREN),
    (Name: 'WS_CLIPSIBLINGS'; Value: WS_CLIPSIBLINGS),
    (Name: 'WS_DISABLED'; Value: WS_DISABLED),
    (Name: 'WS_DLGFRAME'; Value: WS_DLGFRAME),
    (Name: 'WS_GROUP'; Value: WS_GROUP),
    (Name: 'WS_HSCROLL'; Value: WS_HSCROLL),
    (Name: 'WS_ICONIC'; Value: WS_ICONIC),
    (Name: 'WS_MAXIMIZE'; Value: WS_MAXIMIZE),
    (Name: 'WS_MAXIMIZEBOX'; Value: WS_MAXIMIZEBOX),
    (Name: 'WS_MINIMIZE'; Value: WS_MINIMIZE),
    (Name: 'WS_MINIMIZEBOX'; Value: WS_MINIMIZEBOX),
    (Name: 'WS_OVERLAPPED'; Value: WS_OVERLAPPED),
    (Name: 'WS_OVERLAPPEDWINDOW'; Value: WS_OVERLAPPEDWINDOW),
    (Name: 'WS_POPUP'; Value: WS_POPUP),
    (Name: 'WS_POPUPWINDOW'; Value: WS_POPUPWINDOW),
    (Name: 'WS_SIZEBOX'; Value: WS_SIZEBOX),
    (Name: 'WS_SYSMENU'; Value: WS_SYSMENU),
    (Name: 'WS_TABSTOP'; Value: WS_TABSTOP),
    (Name: 'WS_THICKFRAME'; Value: WS_THICKFRAME),
    (Name: 'WS_TILED'; Value: WS_TILED),
    (Name: 'WS_TILEDWINDOW'; Value: WS_TILEDWINDOW),
    (Name: 'WS_VISIBLE'; Value: WS_VISIBLE),
    (Name: 'WS_VSCROLL'; Value: WS_VSCROLL));
  ExStyles: TExStyles = (
    (Name: 'WS_EX_ACCEPTFILES'; Value: WS_EX_ACCEPTFILES),
    (Name: 'WS_EX_APPWINDOW'; Value: WS_EX_APPWINDOW),
    (Name: 'WS_EX_CLIENTEDGE'; Value: WS_EX_CLIENTEDGE),
    (Name: 'WS_EX_COMPOSITED'; Value: WS_EX_COMPOSITED),
    (Name: 'WS_EX_CONTEXTHELP'; Value: WS_EX_CONTEXTHELP),
    (Name: 'WS_EX_CONTROLPARENT'; Value: WS_EX_CONTROLPARENT),
    (Name: 'WS_EX_DLGMODALFRAME'; Value: WS_EX_DLGMODALFRAME),
    (Name: 'WS_EX_LAYERED'; Value: WS_EX_LAYERED),
    (Name: 'WS_EX_LAYOUTRTL'; Value: WS_EX_LAYOUTRTL),
    (Name: 'WS_EX_LEFT'; Value: WS_EX_LEFT),
    (Name: 'WS_EX_LEFTSCROLLBAR'; Value: WS_EX_LEFTSCROLLBAR),
    (Name: 'WS_EX_LTRREADING'; Value: WS_EX_LTRREADING),
    (Name: 'WS_EX_MDICHILD'; Value: WS_EX_MDICHILD),
    (Name: 'WS_EX_NOACTIVATE'; Value: WS_EX_NOACTIVATE),
    (Name: 'WS_EX_NOINHERITLAYOUT'; Value: WS_EX_NOINHERITLAYOUT),
    (Name: 'WS_EX_NOPARENTNOTIFY'; Value: WS_EX_NOPARENTNOTIFY),
     // WS_EX_NOREDIRECTIONBITMAP fehlt unter XE2
    (Name: 'WS_EX_OVERLAPPEDWINDOW'; Value: WS_EX_OVERLAPPEDWINDOW),
    (Name: 'WS_EX_PALETTEWINDOW'; Value: WS_EX_PALETTEWINDOW),
    (Name: 'WS_EX_RIGHT'; Value: WS_EX_RIGHT),
    (Name: 'WS_EX_RIGHTSCROLLBAR'; Value: WS_EX_RIGHTSCROLLBAR),
    (Name: 'WS_EX_RTLREADING'; Value: WS_EX_RTLREADING),
    (Name: 'WS_EX_STATICEDGE'; Value: WS_EX_STATICEDGE),
    (Name: 'WS_EX_TOOLWINDOW'; Value: WS_EX_TOOLWINDOW),
    (Name: 'WS_EX_TOPMOST'; Value: WS_EX_TOPMOST),
    (Name: 'WS_EX_TRANSPARENT'; Value: WS_EX_TRANSPARENT),
    (Name: 'WS_EX_WINDOWEDGE'; Value: WS_EX_WINDOWEDGE));

type
  TLogMethod = procedure(const S: string) of object;

procedure DisplayStyles(LogProc: TLogMethod; Style: DWORD; const Values: array of TStyleRec);
var
  i: Integer;
begin
  for i := low(Values) to high(Values) do
    if (Style and Values[i].Value) = Values[i].Value then
      LogProc('  ' + Values[i].Name);
  for i := low(Values) to high(Values) do
    Style := Style and not Values[i].Value;
  if Style <> 0 then
    LogProc(Format('  unknown style bits: %x', [Style]));
end;

procedure TForm1.ShowStyles(Style: DWORD);
begin
  Display('Window styles: %x', [Style]);
  DisplayStyles(Display, Style, Styles);
end;

procedure TForm1.ShowExStyles(Style: DWORD);
begin
  Display('Extended window styles: %x', [Style]);
  DisplayStyles(Display, Style, ExStyles);
end;

end.

Gruß Thomas

// edit: fehlende Windows Styles und ExStyles hinzugefügt