Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

не получается задать регион элементам окна


Вася ©   (2010-01-28 00:08:00) 

необходимо задать регион элементам окна.в частности статику (с картинкою) и кнопке.
хоть MS Spy++ и показывает что всё как надо, но визуально никакого результата...

в одой статейке нашлось упоминание, что регионы нельзя задавать дочерним окнам, но в VCL же это как-то получается...=((

Вася   (2010-01-29 07:30:00) [1]

спасибо!=)
так совсем нормально стало...^__^

* ушёл учить флаги стилей *

Leonid Troyanovsky   (2010-01-28 11:55:00) [2]


> Вася   (28.01.10 08:39) [9]

> FStatic:=CreateWindow('Static', '', WS_CHILD or SS_BITMAP
> or WS_VISIBLE, 10, 70, 0, 0, Handle, 0, HInstance, nil);

or WS_CLIPSIBLINGS.

--
Regards, LVT.

Вася   (2010-01-28 08:39:00) [3]

интересный код,спасибо...=)
узнал несколько новых приёмов.=))

с кнопками вроде нормально,а вот статик с картинкой всё равно глючит...

procedure TForm1.Button4Click(Sender: TObject);
var StaticRect: TRect;
begin
FStatic:=CreateWindow('Static', '', WS_CHILD or SS_BITMAP or WS_VISIBLE, 10, 70, 0, 0, Handle, 0, HInstance, nil);
FBmp:=LoadImage(HInstance, 'C:\pict.bmp', IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE);
SendMessage(FStatic, STM_SETIMAGE, IMAGE_BITMAP, FBmp);
Windows.GetWindowRect(FStatic, StaticRect);
OffsetRect(StaticRect, -StaticRect.Left, -StaticRect.Top);
FStaticRgn:=CreateEllipticRgnIndirect(StaticRect);
SetWindowRgn(FStatic, FStaticRgn, true);
end;

в вашем примере только один баг остался - сворачиваю окно, разворачиваю - и снова статик квадратный.вот при перекрытии другими окнами не портится, а наоборот восстанавливается если после сворачивания.
когда на VCL делаю то почему-то всегда лучше получается,у меня наоборот было: на чистом WinAPI написал - и при перекрытии портится...=((

а может я просто что-то не учёл?

program Project1;

uses Windows, Messages, Commctrl;

var WinClass: TWndClass;
   hInst, Handle, Image_01, hFont: HWND; Msg: TMsg;
   Bmp: HBITMAP; rgn: HRGN; rect: TRect;

function WindowProc(HWND, Msg, wParam, lParam: Longint): Longint; Stdcall;
begin
Result:=DefWindowProc(HWND, Msg, wParam, lParam);
Case Msg Of
     WM_MOUSEMOVE:
           ;//Windows.Beep(400, 400);
     WM_DESTROY:
           begin
           DeleteObject(hFont);
           UnRegisterClass('mywndclass', hInst);
           ExitProcess(hInst);
           end;
     end;
end;

begin
hInst:=GetModuleHandle(nil);
with WinClass do
     begin
     Style:=CS_PARENTDC;
     hIcon:=LoadIcon(hInst, MAKEINTRESOURCE('MAINICON'));
     lpfnWndProc:=@WindowProc;
     hInstance:=hInst;
     hbrBackground:=COLOR_BTNFACE+3;
     lpszClassName:='mywndclass';
     hCursor:=LoadCursor(0, IDC_ARROW);
     end;
InitCommonControls;
RegisterClass(WinClass);
Handle:=CreateWindowEx(0, 'mywndclass', 'testprogram_05', WS_OVERLAPPEDWINDOW Or WS_VISIBLE Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_SYSMENU, 400, 200, 400, 400, 0, 0, hInst, nil);
hFont:=CreateFont(-11, 0, 0, 0, 0, 0, 0, 0, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH Or FF_DONTCARE, 'MS Sans Serif');
Image_01:=CreateWindow('Static', '', WS_CHILD Or SS_BITMAP Or WS_VISIBLE, 120, 180, 200, 100, Handle, 1, hInst, Nil);
//SendMessage(Image_01, WM_SETFONT, hFont, 0);
Bmp:=LoadImage(hInst, 'C:\pict.bmp', IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE);
SendMessage(Image_01, STM_SETIMAGE, IMAGE_BITMAP, Bmp);
Windows.GetWindowRect(Image_01, rect);
OffsetRect(rect, -rect.Left, -rect.Top);
rgn:=CreateEllipticRgnIndirect(rect);
SetWindowRgn(Image_01, rgn, True);
while (GetMessage(Msg, 0, 0, 0)) do
     begin
     TranslateMessage(Msg);
     DispatchMessage(Msg);
     end;
end.

Игорь Шевченко   (2010-01-28 02:46:00) [4]

Насчет того, что ты не так спросил: если ты пишешь, что у тебя чего-то не получается, то приводи код не после наводящих вопросов, а сразу в вопросе, об чем, кстати, написано в ссылке [4].

Если ты где-то что-то прочитал, чего делать нельзя, дай ссылку на этот материал.

Уважай потенциальных отвечающих, им вытягивать из тебя клещами "главную военную тайну" нафиг не сдалось, есть более интересные способы времяпровождения.

unit main;

interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, Menus;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   PopupMenu1: TPopupMenu;
   File1: TMenuItem;
   Help1: TMenuItem;
   procedure FormShow(Sender: TObject);
   procedure Button1Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   FRgn: HRGN;
   FButtonRgn: HRGN;
   FButton: HWND;
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormShow(Sender: TObject);
begin
 FRgn := CreateEllipticRgnIndirect (Button1.ClientRect);
 SetWindowRgn(Button1.Handle, FRgn, true);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 ButtonRect: TRect;
begin
 FButton := CreateWindowEx(0, 'BUTTON','_OK_',
   WS_CHILD or WS_VISIBLE or WS_CLIPSIBLINGS or BS_PUSHBUTTON,
   10, 10, 70, 25, Handle, 0, HInstance, nil);
 Windows.GetWindowRect(FButton, ButtonRect);
 OffsetRect(ButtonRect, -ButtonRect.Left, -ButtonRect.Top);
 FButtonRgn := CreateEllipticRgnIndirect (ButtonRect);
 Win32Check((FButtonRgn 0) and (SetWindowRgn (FButton, FButtonRgn, true) 0));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 SetWindowLong(Button1.Handle, GWL_STYLE,
   GetWindowLong(Button1.Handle, GWL_STYLE) or BS_MULTILINE);
 Button1.Caption := 'Press'#13#10'Me';
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 P: TPoint;
begin
 P := ClientToScreen(Point(Button2.Left, Button2.Top + Button2.Height));
 PopupMenu1.Popup (P.X, P.Y);
end;

end.

object Form1: TForm1
 Left = 191
 Top = 108
 Caption = 'Form1'
 ClientHeight = 348
 ClientWidth = 536
 Color = clBackground
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = 'MS Sans Serif'
 Font.Style = []
 OldCreateOrder = False
 OnCreate = FormCreate
 OnShow = FormShow
 PixelsPerInch = 96
 TextHeight = 13
 object Button1: TButton
   Left = 244
   Top = 268
   Width = 109
   Height = 57
   Caption = 'Button1'
   TabOrder = 0
   OnClick = Button1Click
 end
 object Button2: TButton
   Left = 204
   Top = 56
   Width = 75
   Height = 25
   Caption = 'Button2'
   TabOrder = 1
   OnClick = Button2Click
 end
 object PopupMenu1: TPopupMenu
   Left = 204
   Top = 88
   object File1: TMenuItem
     Caption = '&File'
   end
   object Help1: TMenuItem
     Caption = '&Help'
   end
 end
end

Игорь Шевченко   (2010-01-28 02:41:00) [5]

Вася   (28.01.10 02:23) [6]

Больше не читай каку.

procedure TForm1.Button1Click(Sender: TObject);
var
 ButtonRect: TRect;
begin
 FButton := CreateWindowEx(0, 'BUTTON','_OK_',
   WS_CHILD or WS_VISIBLE or WS_CLIPSIBLINGS or BS_PUSHBUTTON,
   10, 10, 70, 25, Handle, 0, HInstance, nil);
 Windows.GetWindowRect(FButton, ButtonRect);
 OffsetRect(ButtonRect, -ButtonRect.Left, -ButtonRect.Top);
 FButtonRgn := CreateEllipticRgnIndirect (ButtonRect);
 Win32Check((FButtonRgn <> 0) and (SetWindowRgn (FButton, FButtonRgn, true) <> 0));
end;

Вася   (2010-01-28 02:23:00) [6]

ну и что же не так я спросил?
поиск про регионы мне как раз и дал что регионы нельзя задавать дочерним окнам.
цитирую:

> У функции SetWindowRgn есть ряд особенностей:
> ...
> 3) SetWindowRgn не работает для дочерних окон (окон созданных со стилем WS_CHILD).

Германн   (2010-01-28 01:53:00) [7]


> Игорь Шевченко ©   (28.01.10 00:48) [4]
>
> http://segfault.kiev.ua/smart-questions-ru.html
>

Это что-то новенькое. :)

Игорь Шевченко   (2010-01-28 00:48:00) [8]

http://segfault.kiev.ua/smart-questions-ru.html

Вася   (2010-01-28 00:45:00) [9]

> Игорь Шевченко ©   (28.01.10 00:18) [2]

о_О?

Игорь Шевченко   (2010-01-28 00:18:00) [10]

регион можно задавать любому окну

Игорь Шевченко   (2010-01-28 00:18:00) [11]

Но ты тоже не уважаешь нас. Зачем тебе отвечать ?

Наверх

Титульная страница Поиск, карта сайта Написать письмо