Текущий архив: 2006.04.16;
Скачать: CL | DM;

Вниз

Создание кнопки на GroupBox   Найти похожие ветки 

← →
Delphi_is_cool ©   (2006-03-31 20:18) [0]

Есть кнопка созданная с помощью ф-ции CreateWindow со стилем BS_GROUPBOX(типа TGroupBox"a), на этой кнопке создаётся ещё одна кнопка(стандартная), вопрос: Почему у стандартной кнопки края
какие-то чёрные ?) И как это исправить ?

Код:

...
{$R WindowsXP.res} // Стиль XP
...

var
 gbButton, Button: HWND;
begin
 // Создание GroupBox"a:
 gbButton := CreateWindowEx(WS_EX_CONTROLPARENT, "Button", "Caption", WS_CHILD or WS_VISIBLE or WS_CLIPCHILDREN or BS_GROUPBOX,
                    X, Y, Width, Height, MainHWnd, 0, hInstance, nil);

 // Создание кнопки:
 Button := CreateWindowEx(WS_EX_CONTROLPARENT, "Button", "Caption", WS_CHILD or WS_VISIBLE, X, Y,
                    Width, Height, gbButton, 0, hInstance, nil);
end;


---

← →
Rial ©   (2006-03-31 21:36) [1]

Ты совсем забыл про расширенные настройки окон.


...
Var ControlStyle: TControlStyle;
begin
// Создание GroupBox"a:
ControlStyle:=[csAcceptsControls, csCaptureMouse, csClickEvents,
   csSetCaption, csDoubleClicks, csReplicatable, csParentBackground];
 gbButton := CreateWindowEx(WS_EX_CONTROLPARENT, "Button", "Caption",
Cardinal(ControlStyle) or WS_CHILD or WS_VISIBLE or WS_CLIPCHILDREN or BS_GROUPBOX,
         10, 20, 150, 120, Handle, 0, hInstance, nil);
...


А, вообще говоря, с этим WindowsXP.res только одних проблем прибавилось.

Попробуй, например, задать цвет для кнопки или другого наследника от TWinControl !

---

← →
Rial ©   (2006-03-31 21:37) [2]

P.S.
А можно узнать, зачем вдруг такой изврат к коде ??
Видимо, пишется что - то архикрутое .

---

← →
Delphi_is_cool ©   (2006-04-02 01:32) [3]

Спасибо за ответ ! Но я что-то всё равно не могу разобраться ... Не мог бы ты(или кто-нибудь) показать как это сделать на WinApi если не трудно плз ?

Вот к примеру моя программа:

program Project1;

uses
 Windows, Messages, SysUtils;

{$R *.res}
{$R WindowsXP.res}

const
 CW_USEDEFAULT = Integer(CW_USEDEFAULT);

var
 Message: TMsg;
 MainHWnd, hButton, hGroupBox: HWND;

function WindowProc(Wnd: HWND; Msg: UINT; wParam, lParam: LongInt) : LongInt; stdcall;
begin
 Result := 0;
 case Msg of
   WM_CLOSE:
     Result := DefWindowProc(Wnd, Msg, wParam, lParam);

   WM_DESTROY: PostQuitMessage(0);
 else
   Result := CallWindowProc(Pointer(GetWindowLong(MainHWnd, GWL_USERDATA)), Wnd, Msg, wParam, lParam);
 end;
end;

begin
 MainHWnd := CreateWindow("#32770",
                          nil,
                          WS_OVERLAPPEDWINDOW or WS_VISIBLE,
                          CW_USEDEFAULT,
                          CW_USEDEFAULT,
                          CW_USEDEFAULT,
                          CW_USEDEFAULT,
                          0,
                          0,
                          hInstance,
                          nil);
 SetWindowLong(MainHWnd, GWL_USERDATA, SetWindowLong(MainHWnd, GWL_WNDPROC, Integer(@WindowProc)));

 hGroupBox := CreateWindowEx(0, "Button", "GroupBox", WS_CHILD or WS_VISIBLE or BS_GROUPBOX,
                             10, 10, 150, 150, MainHWnd, 0, hInstance, nil);

 hButton := CreateWindowEx(0, "Button", "Button", WS_CHILD or WS_VISIBLE,
                           20, 30, 75, 25, hGroupBox, 0, hInstance, nil);

 while GetMessage(Message, 0, 0, 0) do
 begin
   TranslateMessage(Message);
   DispatchMessage(Message);
 end;
 Halt(Message.wParam);
end.

Что мне тут надо намутить :) со стилем GroupBox"а, чтоб всё было как положено ?

---

← →
Rial ©   (2006-04-02 02:47) [4]

Тебе 2 совета:
1. Не стоит использовать WindowsXP.res, т.к. при его использовании иногда даже VCL не справляется: отображает некоторые компоненты некорректно, а уж предусмотреть все с использованием API...
2. Используй, наприпер, KOL, если хочешь добаться небольших размеров приложения. (А если тебе оно без разницы, то лучше там не извращаться попусту).

Ты забыл:
1. Зарегистрировать класс.
2. Что такое есть CW_USEDEFAULT = Integer(CW_USEDEFAULT) ? Не вижу смысла.
3. У главного окна WS_VISIBLE не обязательно указывать.
4. Используешь не лучшие в данном случае альтернативы процедур (напр. CallWindowProc).
5. Возможно, я в чем то не прав. Да простят меня всесвядущие.

Дальше мой код минимального окна.

program WinMin;

uses
 Windows,
 Messages;

const
 AppName = "WinMin";

Var
 Window : HWnd;
 hButton1, hLabel1 : HWnd;
 Message : TMsg;
 WindowClass : TWndClass;
 Dc:HDc;

function WindowProc (Window : HWnd; Message, WParam : Word;
        LParam : LongInt) : LongInt; stdcall;
begin
 WindowProc := 0;

 case Message of
      wm_Destroy : begin
                   PostQuitMessage (0);
                   Exit;
                   end;
      // реакция на нажатие кнопки
      wm_Command : if lParam = hButton1 then Beep(2000,500);
      wm_Paint:Rectangle(Dc,0,0,320,240);
 end; // case

 WindowProc := DefWindowProc (Window, Message, WParam, LParam);
end;

begin
 with WindowClass do begin
   Style := cs_HRedraw or cs_VRedraw;
   lpfnWndProc := @WindowProc;
   cbClsExtra := 0;
   cbWndExtra := 0;
   hInstance := 0;
   hIcon := LoadIcon (0, idi_Application);
   hCursor := LoadCursor (0, idc_Arrow);
   hbrBackground := COLOR_BTNFACE + 1;
   lpszMenuName := "";
   lpszClassName := AppName;
 end;

 If RegisterClass (WindowClass) = 0 then Halt (255);
 Window := CreateWindow (AppName, "Win_Min", ws_OverlappedWindow,
    0, 0,320, 240,
    0, 0, HInstance, nil);
 Dc:=GetDC(Window);

 // Создание окна кнопки
 hButton1 := CreateWindow ("Button", "Button1",
   WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or BS_TEXT,
   5, 5, 65, 24, Window, 0, hInstance, nil);

 // Создание окна метки
 hLabel1 := CreateWindow("Static", "Label1", WS_VISIBLE or WS_CHILD or SS_LEFT,
   80, 10, 70, 20, Window, 0, hInstance, nil);

 ShowWindow (Window, CmdShow);
 UpdateWindow (Window);

 // Устанавливаем фокус на кнопке
 SetFocus(hButton1);

 while GetMessage (Message, 0, 0, 0) do begin
   TranslateMessage (Message);
   DispatchMessage (Message);
 end;
 Halt (Message.wParam);

end.


---

← →
antonn ©   (2006-04-02 11:10) [5]

Rial ©   (02.04.06 2:47) [4]
1. Не стоит использовать WindowsXP.res, т.к. при его использовании иногда даже VCL не справляется: отображает некоторые компоненты некорректно, а уж предусмотреть все с использованием API...
а что стоит использовать для поддержки тем ХП и выше?

---

← →
Delphi_is_cool ©   (2006-04-02 15:46) [6]

> Тебе 2 совета:
> 1. Не стоит использовать WindowsXP.res, т.к. при его использовании
> иногда даже VCL не справляется: отображает некоторые компоненты
> некорректно, а уж предусмотреть все с использованием API.

Не замечал пока никаких глюков, а если ты про:

> Попробуй, например, задать цвет для кнопки или другого наследника
> от TWinControl !

У кнопки(TButton) вроде и нет св-ва "Color" :) Но изменить цвет к пимеру TPanel можно:

 with Panel1 do
 begin
   Color := clBlack;
   ControlStyle := ControlStyle - [csParentBackground];
 end;

-

> 2. Используй, наприпер, KOL, если хочешь добаться небольших
> размеров приложения. (А если тебе оно без разницы, то лучше
> там не извращаться попусту).

Мне больше по душе WinApi ...

> Ты забыл:
> 1. Зарегистрировать класс.
> 2. Что такое есть CW_USEDEFAULT = Integer(CW_USEDEFAULT)
> ? Не вижу смысла.
> 3. У главного окна WS_VISIBLE не обязательно указывать.
> 4. Используешь не лучшие в данном случае альтернативы процедур
> (напр. CallWindowProc).
> 5. Возможно, я в чем то не прав. Да простят меня всесвядущие.
>

Ничего я не забыл, а код который я выкладовал был просто как пример, т.к кода меньше, а эффект с кнопкой тот же, да и дело вобщем-то не в этом ...

ps
Ведь делают же люди программы на Api со стилем XP, и всё отображается корректно ....

---

← →
Delphi_is_cool ©   (2006-04-03 20:34) [7]

Всем спасибо, проблему решил :)

program Project1;

uses
 Windows, Messages;

{$R *.res}
{$R WindowsXP.res}

{$EXTERNALSYM DrawThemeParentBackground}
function DrawThemeParentBackground(hwnd: HWND; hdc: HDC; prc: PRECT) : HRESULT; stdcall; external "uxtheme.dll";

const
 CW_USEDEFAULT = Integer(CW_USEDEFAULT);

var
 Message: TMsg;
 MainHWnd, hGroupBox, hButton: HWND;

function WindowProc(Wnd: HWND; Msg: UINT; wParam, lParam: LongInt) : LongInt; stdcall;
begin
 Result := 0;
 case Msg of
   WM_CLOSE:
     Result := DefWindowProc(Wnd, Msg, wParam, lParam);

   WM_DESTROY:
     PostQuitMessage(0);
 else
   Result := CallWindowProc(Pointer(GetWindowLong(Wnd, GWL_USERDATA)), Wnd, Msg, wParam, lParam);
 end;
end;

function GroupBoxProc(Wnd: HWND; Msg: UINT; wParam, lParam: LongInt) : LongInt; stdcall;
begin
 Result := 0;
 case Msg of
   WM_COMMAND:
     if HWND(lParam) = hButton then
       MessageBox(MainHWnd, "I am a cool XP button :)", "", MB_ICONINFORMATION);

   WM_CTLCOLORBTN:
     DrawThemeParentBackground(Wnd, wParam, nil);
 else
   Result := CallWindowProc(Pointer(GetWindowLong(Wnd, GWL_USERDATA)), Wnd, Msg, wParam, lParam);
 end;
end;

begin
 MainHWnd := CreateWindow("#32770", nil, WS_OVERLAPPEDWINDOW or WS_VISIBLE,
                          CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, hInstance, nil);
 SetWindowLong(MainHWnd, GWL_USERDATA, SetWindowLong(MainHWnd, GWL_WNDPROC, Integer(@WindowProc)));

 hGroupBox := CreateWindow("Button", "GroupBox", WS_CHILD or WS_VISIBLE or BS_GROUPBOX,
                           10, 10, 150, 150, MainHWnd, 0, hInstance, nil);
 SetWindowLong(hGroupBox, GWL_USERDATA, SetWindowLong(hGroupBox, GWL_WNDPROC, Integer(@GroupBoxProc)));

 hButton := CreateWindow("Button", "Button", WS_CHILD or WS_VISIBLE,
                         20, 30, 75, 25, hGroupBox, 0, hInstance, nil);

 while GetMessage(Message, 0, 0, 0) do
 begin
   TranslateMessage(Message);
   DispatchMessage(Message);
 end;
 Halt(Message.wParam);
end.


---

Страницы: 1 вся ветка

Текущий архив: 2006.04.16;
Скачать: CL | DM;

Наверх

Память: 0.51 MB
Время: 0.039 c