Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »



Вопрос # 1 272

Раздел: Delphi » Прочее
/ вопрос открыт /

Здравствуйте!
Я прочитал статью Создание непрямоугольных форм в Delphi, но никак не могу ёе использовать в программе.
Напишите пожалуйста какой-нибудь пример.
Заранее спасибо

John-1641 Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: John-1641 (статус: Посетитель)
Вопрос отправлен: 18 января 2008, 15:06
Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: Feniks

Здравствуйте, John!
Держите несколько примеров:
1. Как создавать не квадратные формы и контролы?
2. Как создать круглую форму?
3. Как сделать дырку в окне?
4. Как сделать roll-up форму?
5. Как создать форму в форме эллипса ?
6. Создание форм с закругленными краями
А так же в атаче две статьи: «Создание окон произвольной формы и Работа с регионами».
К ответу прикреплён файл. Загрузить » (срок хранения: 60 дней с момента отправки ответа)

Приложение:
  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7. var
  8. MaskBmp: TBitmap;
  9. begin
  10. MaskBmp := TBitmap.Create;
  11. try
  12. MaskBmp.LoadFromFile('FormShape.bmp');
  13. Height := MaskBmp.Height;
  14. Width := MaskBmp.Width;
  15.  
  16. SetWindowRgn(Self.Handle, BitmapToRgn(MaskBmp), True);
  17. finally
  18. MaskBmp.Free;
  19. end;
  20. end;
  21. ===============
  22.  
  23.  
  24.  
  25. unit Unit1;
  26.  
  27. interface
  28.  
  29. uses
  30. Windows, Messages, SysUtils, Classes, Graphics, Controls,
  31. Forms, Dialogs, ExtCtrls, Buttons, StdCtrls;
  32.  
  33. type
  34. TForm1 = class(TForm)
  35. Button1: TButton;
  36. procedure FormCreate(Sender: TObject);
  37. procedure Button1Click(Sender: TObject);
  38. private
  39. { Private-Deklarationen}
  40. procedure CreateParams(var Params: TCreateParams); override;
  41. public
  42. { Public-Deklarationen}
  43. end;
  44.  
  45. var
  46. Form1: TForm1;
  47.  
  48. implementation
  49.  
  50. {$R *.DFM}
  51.  
  52. { TForm1 }
  53.  
  54. procedure TForm1.CreateParams(var Params: TCreateParams);
  55. begin
  56. inherited CreateParams(Params);
  57.  
  58.  
  59. Params.Style := Params.Style or ws_popup xor ws_dlgframe;
  60. end;
  61.  
  62. procedure TForm1.FormCreate(Sender: TObject);
  63. var
  64. FormRgn: hRgn;
  65. begin
  66. {clear form}
  67. Form1.Brush.Style := bsSolid; //bsclear;
  68.  
  69. GetWindowRgn(Form1.Handle, FormRgn);
  70.  
  71.  
  72. DeleteObject(FormRgn);
  73.  
  74. Form1.Height := 500;
  75. Form1.Width := Form1.Height;
  76.  
  77. FormRgn := CreateRoundRectRgn(1, 1, Form1.Width - 1,
  78. Form1.height - 1, Form1.width, Form1.height);
  79.  
  80.  
  81. SetWindowRgn(Form1.Handle, FormRgn, TRUE);
  82. end;
  83.  
  84. procedure TForm1.Button1Click(Sender: TObject);
  85. begin
  86. Form1.close;
  87. end;
  88.  
  89. end.
  90. ==============
  91.  
  92. procedure TForm1.Button4Click(Sender: TObject);
  93. var
  94. HRegion1, Hreg2, Hreg3: THandle;
  95. Col: TColor;
  96. begin
  97. ShowMessage ('Ready for a real crash?');
  98. Col := Color;
  99. Color := clRed;
  100. PlaySound ('boom.wav', 0, snd_sync);
  101. HRegion1 := CreatePolygonRgn (Pts,
  102. sizeof (Pts) div 8,
  103. alternate);
  104. SetWindowRgn (
  105. Handle, HRegion1, True);
  106. ShowMessage ('Now, what have you done?');
  107. Color := Col;
  108.  
  109. end;
  110. ===============
  111.  
  112. unit testmain;
  113.  
  114. interface
  115.  
  116. uses
  117. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  118. ExtCtrls, StdCtrls, Buttons, ShellAPI;
  119.  
  120. type
  121. TForm1 = class(TForm)
  122. procedure FormCreate(Sender: TObject);
  123. private
  124. { Private declarations }
  125. FOldHeight: Integer;
  126. procedure WMNCRButtonDown(var Msg: TWMNCRButtonDown);
  127. message WM_NCRBUTTONDOWN;
  128. public
  129. { Public declarations }
  130. end;
  131.  
  132. var
  133. Form1: TForm1;
  134.  
  135. implementation
  136.  
  137. {$R *.DFM}
  138.  
  139. procedure TForm1.FormCreate(Sender: TObject);
  140. begin
  141. FOldHeight := ClientHeight;
  142. end;
  143.  
  144. procedure TForm1.WMNCRButtonDown(var Msg: TWMNCRButtonDown);
  145. var
  146. I: Integer;
  147. begin
  148. if (Msg.HitTest = HTCAPTION) then
  149. if (ClientHeight = 0) then
  150. begin
  151. I := 0;
  152. while (I < FOldHeight) do
  153. begin
  154. I := I + 40;
  155. if (I > FOldHeight) then
  156. I := FOldHeight;
  157. ClientHeight := I;
  158. Application.ProcessMessages;
  159. end;
  160. end
  161. else
  162. begin
  163. FOldHeight := ClientHeight;
  164. I := ClientHeight;
  165. while (I > 0) do
  166. begin
  167. I := I - 40;
  168. if (I < 0) then
  169. I := 0;
  170. ClientHeight := I;
  171. Application.ProcessMessages;
  172. end;
  173. end;
  174. end;
  175.  
  176. end.
  177. First, by way of synopsis, the roll-up/down occurs in response to a WM_NCRBUTTONDOWN message firing off and the WMNCRButtonDown procedure handling the message, telling the window to roll up/down depending upon the height of the client area. WM_NCRBUTTONDOWN fires whenever the right mouse button is clicked in a "non-client" area, such as a border, menu or, for our purposes, the caption bar of a form. (The client area of a window is the area within the border where most of the interesting activity usually occurs. In general, the Windows API restricts application code to drawing only within the client area.)
  178.  
  179. Delphi encapsulates the WM_NCRBUTTONDOWN in a TWMNCRButtonDown type, which is actually an assignment from a TWMNCHitMessage type that has the following structure:
  180. type
  181. TWMNCHitMessage = record
  182. Msg: Cardinal;
  183. HitTest: Integer;
  184. XCursor: SmallInt;
  185. YCursor: SmallInt;
  186. Result: Longint;
  187. end;
  188. It's easy to create message wrappers in Delphi to deal with messages that aren't handled by an object by default. Since a right-click on the title bar of a form isn't handled by default, I had to create a wrapper. The procedure procedure WMNCRButtonDown(var Msg : TWMNCRButtonDown); message WM_NCRBUTTONDOWN; is the wrapper I created. All that goes on in the procedure is the following:
  189.  
  190. In order to make this work, I had to create a variable called FOldHeight and set its value at FormCreate whenever the form was to be rolled up. FOldHeight is used as a place for the form to remember what size it was before it was re-sized to 0. When a form is to be rolled up, FOldHeight is immediately set to the current ClientHeight, which means you can interactively set the form's size, and the function will always return the form's ClientHeight to what it was before you rolled it up.
  191.  
  192. So what use is this? Well, sometimes I don't want to iconize a window; I just want to get it out of the way so I can see what's underneath. Having the capability to roll a form up to its title bar makes it a lot easier to see underneath a window without iconizing it, then having to Alt-tab back to it. (If you are familiar with the Macintosh platform, the System 7.5 environment offers a very similar facility called a "window shade," and makes a roll-up sound when the shade goes up.)
  193. =================
  194.  
  195. procedure TForm1.FormCreate(Sender: TObject);
  196. var
  197. Region: HRGN;
  198. begin
  199. Region := CreateEllipticRgn(0, 0, 300, 300);
  200. SetWindowRgn(Handle, Region, True);
  201. end;
  202. =============
  203.  
  204. {
  205. Die CreateRoundRectRgn lasst eine Form mit abgerundeten Ecken erscheinen.
  206.  
  207. The CreateRoundRectRgn function creates a rectangular
  208. region with rounded corners
  209. }
  210.  
  211. procedure TForm1.FormCreate(Sender: TObject);
  212. var
  213. rgn: HRGN;
  214. begin
  215. Form1.Borderstyle := bsNone;
  216. rgn := CreateRoundRectRgn(0,// x-coordinate of the region's upper-left corner
  217. 0, // y-coordinate of the region's upper-left corner
  218. ClientWidth, // x-coordinate of the region's lower-right corner
  219. ClientHeight, // y-coordinate of the region's lower-right corner
  220. 40, // height of ellipse for rounded corners
  221. 40); // width of ellipse for rounded corners
  222. SetWindowRgn(Handle, rgn, True);
  223. end
  224.  
  225.  
  226. { The CreatePolygonRgn function creates a polygonal region. }
  227.  
  228.  
  229. procedure TForm1.FormCreate(Sender: TObject);
  230. const
  231. C = 20;
  232. var
  233. Points: array [0..7] of TPoint;
  234. h, w: Integer;
  235. begin
  236. h := Form1.Height;
  237. w := Form1.Width;
  238. Points[0].X := C; Points[0].Y := 0;
  239. Points[1].X := 0; Points[1].Y := C;
  240. Points[2].X := 0; Points[2].Y := h - c;
  241. Points[3].X := C; Points[3].Y := h;
  242.  
  243. Points[4].X := w - c; Points[4].Y := h;
  244. Points[5].X := w; Points[5].Y := h - c;
  245.  
  246. Points[6].X := w; Points[6].Y := C;
  247. Points[7].X := w - C; Points[7].Y := 0;
  248.  
  249. SetWindowRgn(Form1.Handle, CreatePolygonRgn(Points, 8, WINDING), True);
  250. end;


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 18 января 2008, 16:09
Оценка за ответ: 5

Комментарий к оценке: Огромное спасибо!

Мини-форум вопроса

Мини-форум пуст.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Версия движка: 2.6+ (26.01.2011)
Текущее время: 21 октября 2017, 20:22
Выполнено за 0.03 сек.
Рейтинг@Mail.ru