| blob | 871cd4122e528ad2c0f8ce9b3ba76994ecec8b78 |
1 {$I KOLDEF.INC}\r
2 \r
3 type\r
4 TKOLMenuDesign = class(TForm)\r
5 public\r
6 tvMenu: TTreeView;\r
7 btAdd: TButton;\r
8 btDelete: TButton;\r
9 btSubmenu: TButton;\r
10 btUp: TBitBtn;\r
11 btDown: TBitBtn;\r
12 btOK: TButton;\r
13 btInsert: TButton;\r
14 chbStayOnTop: TCheckBox;\r
15 procedure btInsertClick(Sender: TObject);\r
16 procedure tvMenuChange(Sender: TObject; Node: TTreeNode);\r
17 procedure btAddClick(Sender: TObject);\r
18 procedure btSubmenuClick(Sender: TObject);\r
19 procedure btDeleteClick(Sender: TObject);\r
20 procedure btOKClick(Sender: TObject);\r
21 procedure chbStayOnTopClick(Sender: TObject);\r
22 procedure btUpClick(Sender: TObject);\r
23 procedure btDownClick(Sender: TObject);\r
24 private\r
25 FMenuComponent: TComponent;\r
26 procedure FormDestroy(Sender: TObject);\r
27 procedure FormClose(Sender: TObject; var Action: TCloseAction);\r
28 procedure FormKeyDown(Sender: TObject; var Key: Word;\r
29 Shift: TShiftState);\r
30 procedure Set_Menu(const Value: TComponent);\r
31 { Private declarations }\r
32 procedure NewItem( Insert, SubItem: Boolean );\r
33 procedure CheckButtons;\r
34 function MenuItemTitle( MI: TComponent ): String;\r
35 public\r
36 { Public declarations }\r
37 Constructor Create( AOwner: TComponent ); override;\r
38 property MenuComponent: TComponent read FMenuComponent write Set_Menu;\r
39 procedure MakeActive;\r
40 procedure RefreshItems;\r
41 end;\r
42 \r
43 var\r
44 KOLMenuDesign: TKOLMenuDesign;\r
45 \r
46 implementation\r
47 \r
48 uses\r
49 mckObjs, mirror;\r
50 \r
51 //{$R *.DFM}\r
52 //{$R MckMenuEdArrows.res}\r
53 \r
54 { TMenuDesign }\r
55 \r
56 procedure TKOLMenuDesign.MakeActive;\r
57 var MI: TKOLMenuItem;\r
58 F: TForm;\r
59 D: IDesigner;\r
60 FD: IFormDesigner;\r
61 begin\r
62 if tvMenu.Items.Count > 0 then\r
63 if tvMenu.Selected = nil then\r
64 tvMenu.Selected := tvMenu.Items[ 0 ];\r
65 if tvMenu.Selected <> nil then\r
66 begin\r
67 MI := tvMenu.Selected.Data;\r
68 if MI = nil then Exit;\r
69 // set here MI as a current component in Object Inspector\r
70 F := (MenuComponent as TKOLMenu).ParentForm;\r
71 if F <> nil then\r
72 begin\r
73 //*///////////////////////////////////////////////////////\r
74 {$IFDEF _D6orHigher} //\r
75 F.Designer.QueryInterface(IFormDesigner,D); //\r
76 {$ELSE} //\r
77 //*///////////////////////////////////////////////////////\r
78 D := F.Designer;\r
79 //*///////////////////////////////////////////////////////\r
80 {$ENDIF} //\r
81 //*///////////////////////////////////////////////////////\r
82 if D <> nil then\r
83 if QueryFormDesigner( D, FD ) then\r
84 begin\r
85 RemoveSelection( FD );\r
86 FD.SelectComponent( MI );\r
87 end;\r
88 end;\r
89 end;\r
90 CheckButtons;\r
91 end;\r
92 \r
93 procedure TKOLMenuDesign.Set_Menu(const Value: TComponent);\r
94 var M: TKOLMenu;\r
95 I: Integer;\r
96 MI: TKOLMenuItem;\r
97 \r
98 procedure AddItem( Node: TTreeNode; MI: TKOLMenuItem );\r
99 var NewNode: TTreeNode;\r
100 I: Integer;\r
101 begin\r
102 NewNode := tvMenu.Items.AddChild( Node, MenuItemTitle( MI ) );\r
103 NewNode.Data := MI;\r
104 for I := 0 to MI.Count - 1 do\r
105 AddItem( NewNode, MI.SubItems[ I ] );\r
106 end;\r
107 \r
108 begin\r
109 FMenuComponent := Value;\r
110 M := Value as TKOLMenu;\r
111 tvMenu.HandleNeeded;\r
112 tvMenu.Items.BeginUpdate;\r
113 try\r
114 \r
115 tvMenu.Items.Clear;\r
116 for I := 0 to M.Count - 1 do\r
117 begin\r
118 MI := M.Items[ I ];\r
119 AddItem( nil, MI );\r
120 end;\r
121 \r
122 if tvMenu.Items.Count > 0 then\r
123 tvMenu.FullExpand;\r
124 finally\r
125 tvMenu.Items.EndUpdate;\r
126 end;\r
127 {$IFNDEF _D5orD6} // Bug in earlier Delphi2..Delphi4\r
128 tvMenu.Items.EndUpdate;\r
129 {$ENDIF}\r
130 \r
131 CheckButtons;\r
132 MakeActive;\r
133 end;\r
134 \r
135 procedure TKOLMenuDesign.btInsertClick(Sender: TObject);\r
136 begin\r
137 NewItem( True, False );\r
138 end;\r
139 \r
140 procedure TKOLMenuDesign.FormDestroy(Sender: TObject);\r
141 var M: TKOLMenu;\r
142 begin\r
143 if MenuComponent <> nil then\r
144 try\r
145 M := MenuComponent as TKOLMenu;\r
146 M.ActiveDesign := nil;\r
147 except\r
148 end;\r
149 end;\r
150 \r
151 procedure TKOLMenuDesign.tvMenuChange(Sender: TObject; Node: TTreeNode);\r
152 begin\r
153 MakeActive;\r
154 CheckButtons;\r
155 end;\r
156 \r
157 procedure TKOLMenuDesign.CheckButtons;\r
158 begin\r
159 btDelete.Enabled := (tvMenu.Selected <> nil) and (tvMenu.Selected.Count = 0);\r
160 btSubmenu.Enabled := (tvMenu.Selected <> nil) and (tvMenu.Selected.Count = 0);\r
161 btUp.Enabled := (tvMenu.Selected <> nil) and (tvMenu.Selected.GetPrevSibling <> nil);\r
162 btDown.Enabled := (tvMenu.Selected <> nil) and (tvMenu.Selected.GetNextSibling <> nil);\r
163 end;\r
164 \r
165 procedure TKOLMenuDesign.NewItem(Insert, Subitem: Boolean);\r
166 var N, NN: TTreeNode;\r
167 MI: TKOLMenuItem;\r
168 C: TComponent;\r
169 I: Integer;\r
170 AParent: TKOLMenuItem;\r
171 begin\r
172 N := tvMenu.Selected;\r
173 if (N = nil) and (tvMenu.Items.Count > 0) then Exit;\r
174 \r
175 if (N = nil) or (N.Parent = nil) and not SubItem then\r
176 C := MenuComponent\r
177 else\r
178 if (N <> nil) and SubItem then\r
179 C := N.Data\r
180 else\r
181 C := N.Parent.Data;\r
182 \r
183 if (N <> nil) and not Subitem and not Insert then\r
184 if N.GetNextSibling <> nil then\r
185 begin\r
186 Insert := True;\r
187 N := N.GetNextSibling;\r
188 end;\r
189 \r
190 AParent := nil;\r
191 if C is TKOLMenuItem then\r
192 AParent := C as TKOLMenuItem;\r
193 if Subitem or (N = nil) then\r
194 MI := TKOLMenuItem.Create( MenuComponent, AParent, nil )\r
195 else\r
196 if not Insert and (N.GetNextSibling = nil) then\r
197 MI := TKOLMenuItem.Create( MenuComponent, AParent, nil )\r
198 else\r
199 MI := TKOLMenuItem.Create( MenuComponent, AParent, N.Data );\r
200 \r
201 for I := 1 to MaxInt do\r
202 begin\r
203 if MenuComponent <> nil then\r
204 if (MenuComponent as TKOLMenu).NameAlreadyUsed( 'N' + IntToStr( I ) ) then\r
205 continue;\r
206 MI.Name := 'N' + IntToStr( I );\r
207 break;\r
208 end;\r
209 \r
210 if (N = nil) or (not Insert and not SubItem) then\r
211 NN := tvMenu.Items.Add( N, '[ ' + MI.Name + ' ]' )\r
212 else\r
213 if not Subitem then\r
214 NN := tvMenu.Items.Insert( N, '[ ' + MI.Name + ' ]' )\r
215 else\r
216 begin\r
217 NN := tvMenu.Items.AddChild( N, '[ ' + MI.Name + ' ]' );\r
218 end;\r
219 \r
220 NN.Data := MI;\r
221 NN.MakeVisible;\r
222 tvMenu.Selected := NN;\r
223 CheckButtons;\r
224 MakeActive;\r
225 end;\r
226 \r
227 procedure TKOLMenuDesign.RefreshItems;\r
228 var I: Integer;\r
229 N: TTreeNode;\r
230 MI: TKOLMenuItem;\r
231 begin\r
232 for I := 0 to tvMenu.Items.Count - 1 do\r
233 begin\r
234 N := tvMenu.Items[ I ];\r
235 MI := N.Data;\r
236 if MI <> nil then\r
237 N.Text := MenuItemTitle( MI );\r
238 end;\r
239 end;\r
240 \r
241 procedure TKOLMenuDesign.btAddClick(Sender: TObject);\r
242 begin\r
243 NewItem( False, False );\r
244 end;\r
245 \r
246 procedure TKOLMenuDesign.btSubmenuClick(Sender: TObject);\r
247 begin\r
248 NewItem( False, True );\r
249 end;\r
250 \r
251 procedure TKOLMenuDesign.btDeleteClick(Sender: TObject);\r
252 var N, NN: TTreeNode;\r
253 MI: TKOLMenuItem;\r
254 S: String;\r
255 F: TForm;\r
256 D: IDesigner;\r
257 FD: IFormDesigner;\r
258 begin\r
259 N := tvMenu.Selected;\r
260 if N = nil then Exit;\r
261 S := N.Text;\r
262 Rpt( 'Deleting: ' + S );\r
263 MI := N.Data;\r
264 if MI = nil then Exit;\r
265 NN := N.GetNextSibling;\r
266 if NN = nil then\r
267 NN := N.GetPrevSibling;\r
268 if NN = nil then\r
269 NN := N.Parent;\r
270 if NN = nil then\r
271 begin\r
272 if MenuComponent <> nil then\r
273 begin\r
274 F := (MenuComponent as TKOLMenu).ParentForm;\r
275 if F <> nil then\r
276 begin\r
277 //*///////////////////////////////////////////////////////\r
278 {$IFDEF _D6orHigher} //\r
279 F.Designer.QueryInterface(IFormDesigner,D); //\r
280 {$ELSE} //\r
281 //*///////////////////////////////////////////////////////\r
282 D := F.Designer;\r
283 //*///////////////////////////////////////////////////////\r
284 {$ENDIF} //\r
285 //*///////////////////////////////////////////////////////\r
286 if D <> nil then\r
287 if QueryFormDesigner( D, FD ) then\r
288 begin\r
289 RemoveSelection( FD );\r
290 FD.SelectComponent( MenuComponent );\r
291 end;\r
292 end;\r
293 end;\r
294 end;\r
295 N.Free;\r
296 Rpt( 'Deleted: ' + S );\r
297 S := MI.Name;\r
298 MI.Free;\r
299 Rpt( 'ITEM Destroyed: ' + S );\r
300 if NN <> nil then\r
301 begin\r
302 tvMenu.Selected := NN;\r
303 Rpt( 'Selected: ' + IntToStr( Integer( NN ) ) );\r
304 end;\r
305 if MenuComponent <> nil then\r
306 begin\r
307 (MenuComponent as TKOLMenu).Change;\r
308 Rpt( 'Changed: ' + MenuComponent.Name );\r
309 end;\r
310 CheckButtons;\r
311 Rpt( 'Buttons checked. Deleting of ' + S + ' finished.' );\r
312 end;\r
313 \r
314 procedure TKOLMenuDesign.btOKClick(Sender: TObject);\r
315 begin\r
316 Close;\r
317 end;\r
318 \r
319 function TKOLMenuDesign.MenuItemTitle(MI: TComponent): String;\r
320 begin\r
321 Result := (MI as TKOLMenuITem).Caption;\r
322 if Result = '' then\r
323 Result := '[ ' + MI.Name + ' ]';\r
324 end;\r
325 \r
326 procedure TKOLMenuDesign.FormClose(Sender: TObject;\r
327 var Action: TCloseAction);\r
328 var F: TForm;\r
329 D: IDesigner;\r
330 FD: IFormDesigner;\r
331 begin\r
332 if MenuComponent <> nil then\r
333 begin\r
334 Rpt( 'Closing KOLMenuEditor form' );\r
335 F := (MenuComponent as TKOLMenu).ParentForm;\r
336 if F <> nil then\r
337 begin\r
338 Rpt( 'Form found: ' + F.Name );\r
339 //*///////////////////////////////////////////////////////\r
340 {$IFDEF _D6orHigher} //\r
341 F.Designer.QueryInterface(IFormDesigner,D); //\r
342 {$ELSE} //\r
343 //*///////////////////////////////////////////////////////\r
344 D := F.Designer;\r
345 //*///////////////////////////////////////////////////////\r
346 {$ENDIF} //\r
347 //*///////////////////////////////////////////////////////\r
348 if D <> nil then\r
349 begin\r
350 Rpt( 'IDesigner interface returned' );\r
351 if QueryFormDesigner( D, FD ) then\r
352 begin\r
353 Rpt( 'IFormDesigner interface quered' );\r
354 try\r
355 RemoveSelection( FD );\r
356 FD.SelectComponent( MenuComponent );\r
357 except\r
358 Rpt( 'EXCEPTION *** Could not clear selection!' )\r
359 end;\r
360 end;\r
361 end;\r
362 end;\r
363 end;\r
364 end;\r
365 \r
366 procedure TKOLMenuDesign.chbStayOnTopClick(Sender: TObject);\r
367 begin\r
368 if chbStayOnTop.Checked then\r
369 FormStyle := fsStayOnTop\r
370 else\r
371 FormStyle := fsNormal;\r
372 end;\r
373 \r
374 procedure TKOLMenuDesign.btUpClick(Sender: TObject);\r
375 var CurNode: TTreeNode;\r
376 CurMI: TKOLMenuItem;\r
377 AC: TControl;\r
378 begin\r
379 CurNode := tvMenu.Selected;\r
380 if CurNode = nil then Exit;\r
381 if CurNode.GetPrevSibling = nil then Exit;\r
382 CurMI := CurNode.Data;\r
383 if CurMI = nil then Exit;\r
384 if MenuComponent = nil then Exit;\r
385 if not(MenuComponent is TKOLMenu) then Exit;\r
386 CurMI.MoveUp;\r
387 CurNode.MoveTo( CurNode.GetPrevSibling, naInsert );\r
388 AC := ActiveControl;\r
389 CheckButtons;\r
390 if AC = btUp then\r
391 if not btUp.Enabled then\r
392 PostMessage( Handle, WM_NEXTDLGCTL, 0, 0 );\r
393 end;\r
394 \r
395 procedure TKOLMenuDesign.btDownClick(Sender: TObject);\r
396 var CurNode: TTreeNode;\r
397 CurMI: TKOLMenuItem;\r
398 AC: TControl;\r
399 begin\r
400 CurNode := tvMenu.Selected;\r
401 if CurNode = nil then Exit;\r
402 if CurNode.GetNextSibling = nil then Exit;\r
403 CurMI := CurNode.Data;\r
404 if CurMI = nil then Exit;\r
405 if MenuComponent = nil then Exit;\r
406 if not(MenuComponent is TKOLMenu) then Exit;\r
407 CurMI.MoveDown;\r
408 if CurNode.GetNextSibling.GetNextSibling = nil then\r
409 CurNode.MoveTo( CurNode.GetNExtSibling, naAdd )\r
410 else\r
411 CurNode.MoveTo( CurNode.GetNextSibling.GetNextSibling, naInsert );\r
412 AC := ActiveControl;\r
413 CheckButtons;\r
414 if AC = btDown then\r
415 if not btDown.Enabled then\r
416 PostMessage( Handle, WM_NEXTDLGCTL, 0, 0 );\r
417 end;\r
418 \r
419 procedure TKOLMenuDesign.FormKeyDown(Sender: TObject; var Key: Word;\r
420 Shift: TShiftState);\r
421 begin\r
422 case Key of\r
423 VK_DELETE:\r
424 if btDelete.Enabled then\r
425 btDelete.Click;\r
426 VK_INSERT:\r
427 if btInsert.Enabled then\r
428 btInsert.Click;\r
429 VK_UP:\r
430 if GetKeyState( VK_CONTROL ) < 0 then\r
431 if btUp.Enabled then\r
432 btUp.Click;\r
433 VK_DOWN:\r
434 if GetKeyState( VK_CONTROL ) < 0 then\r
435 if btDown.Enabled then\r
436 btDown.Click;\r
437 VK_RIGHT:\r
438 begin\r
439 if (tvMenu.Selected <> nil) and (tvMenu.Selected.Count = 0) then\r
440 begin\r
441 if btSubmenu.Enabled then\r
442 btSubmenu.Click;\r
443 Key := 0;\r
444 end\r
445 {else\r
446 if ActiveControl <> tvMenu then\r
447 Key := 0};\r
448 end;\r
449 VK_LEFT:\r
450 begin\r
451 {if ActiveControl <> tvMenu then\r
452 Key := 0};\r
453 end;\r
454 end;\r
455 end;\r
456 \r
457 constructor TKOLMenuDesign.Create(AOwner: TComponent);\r
458 begin\r
459 CreateNew(AOwner);\r
460 Left := 299;\r
461 Top := 81;\r
462 BorderIcons := [biSystemMenu, biMinimize];\r
463 BorderStyle := bsToolWindow ;\r
464 ClientHeight := 299 ;\r
465 ClientWidth := 343 ;\r
466 //Color := clBtnFace ;\r
467 //Font.Charset := DEFAULT_CHARSET ;\r
468 //Font.Color := clWindowText ;\r
469 //Font.Height := -11 ;\r
470 //Font.Name := 'MS Sans Serif' ;\r
471 //Font.Style := [] ;\r
472 KeyPreview := True ;\r
473 //OldCreateOrder := False ;\r
474 {$IFDEF _D4orD5}\r
475 Position := poDesktopCenter ;\r
476 {$ENDIF}\r
477 {$IFDEF _D2orD3}\r
478 Position := poScreenCenter ;\r
479 {$ENDIF}\r
480 Scaled := False ;\r
481 Visible := True ;\r
482 OnClose := FormClose ;\r
483 OnDestroy := FormDestroy ;\r
484 OnKeyDown := FormKeyDown ;\r
485 //PixelsPerInch := 96 ;\r
486 //TextHeight := 13 ;\r
487 \r
488 tvMenu := TTreeView.Create( Self ) ;\r
489 tvMenu.Parent := Self ;\r
490 tvMenu.Left := 6 ;\r
491 tvMenu.Top := 6 ;\r
492 tvMenu.Width := 227 ;\r
493 tvMenu.Height := 285 ;\r
494 tvMenu.HideSelection := False ;\r
495 //tvMenu.Indent := 19 ;\r
496 tvMenu.ReadOnly := True ;\r
497 //tvMenu.TabOrder := 0 ;\r
498 tvMenu.OnChange := tvMenuChange ;\r
499 \r
500 btOK := TButton.Create( Self ) ;\r
501 btOK.Parent := Self;\r
502 btOK.Left := 244 ;\r
503 btOK.Top := 6 ;\r
504 btOK.Width := 91 ;\r
505 btOK.Height := 25 ;\r
506 btOK.Caption := 'Close' ;\r
507 //btOK.TabOrder := 1 ;\r
508 btOK.OnClick := btOKClick ;\r
509 \r
510 btUp := TBitBtn.Create( Self ) ;\r
511 btUp.Parent := Self;\r
512 btUp.Left := 244 ;\r
513 btUp.Top := 90 ;\r
514 btUp.Width := 40 ;\r
515 btUp.Height := 27 ;\r
516 btUp.Enabled := False ;\r
517 //btUp.TabOrder := 2 ;\r
518 btUp.OnClick := btUpClick ;\r
519 btUp.Glyph.Handle := LoadBitmap( hInstance, 'MCKARROWUP' );\r
520 \r
521 btDown := TBitBtn.Create( Self ) ;\r
522 btDown.Parent := Self;\r
523 btDown.Left := 295 ;\r
524 btDown.Top := 90 ;\r
525 btDown.Width := 40 ;\r
526 btDown.Height := 27 ;\r
527 btDown.Enabled := False ;\r
528 //btDown.TabOrder := 3 ;\r
529 btDown.OnClick := btDownClick ;\r
530 btDown.Glyph.Handle := LoadBitmap( hInstance, 'MCKARROWDN' );\r
531 \r
532 btInsert := TButton.Create( Self ) ;\r
533 btInsert.Parent := Self;\r
534 btInsert.Left := 244 ;\r
535 btInsert.Top := 170 ;\r
536 btInsert.Width := 91 ;\r
537 btInsert.Height := 25 ;\r
538 btInsert.Caption := 'Insert' ;\r
539 //btInsert.TabOrder := 4 ;\r
540 btInsert.OnClick := btInsertClick ;\r
541 \r
542 btAdd := TButton.Create( Self ) ;\r
543 btAdd.Parent := Self;\r
544 btAdd.Left := 244 ;\r
545 btAdd.Top := 202 ;\r
546 btAdd.Width := 91 ;\r
547 btAdd.Height := 25 ;\r
548 btAdd.Caption := 'Add' ;\r
549 //btAdd.TabOrder := 5 ;\r
550 btAdd.OnClick := btAddClick ;\r
551 \r
552 btDelete := TButton.Create( Self ) ;\r
553 btDelete.Parent := Self;\r
554 btDelete.Left := 244 ;\r
555 btDelete.Top := 234 ;\r
556 btDelete.Width := 91 ;\r
557 btDelete.Height := 25 ;\r
558 btDelete.Caption := 'Delete' ;\r
559 btDelete.Enabled := False ;\r
560 //btDelete.TabOrder := 6 ;\r
561 btDelete.OnClick := btDeleteClick ;\r
562 \r
563 btSubmenu := TButton.Create( Self ) ;\r
564 btSubMenu.Parent := Self;\r
565 btSubmenu.Left := 244 ;\r
566 btSubmenu.Top := 266 ;\r
567 btSubmenu.Width := 91 ;\r
568 btSubmenu.Height := 25 ;\r
569 btSubmenu.Caption := 'New submenu' ;\r
570 btSubmenu.Enabled := False ;\r
571 //btSubmenu.TabOrder := 7 ;\r
572 btSubmenu.OnClick := btSubmenuClick ;\r
573 \r
574 chbStayOnTop := TCheckBox.Create( Self ) ;\r
575 chbStayOnTop.Parent := Self;\r
576 chbStayOnTop.Left := 244 ;\r
577 chbStayOnTop.Top := 40 ;\r
578 chbStayOnTop.Width := 91 ;\r
579 chbStayOnTop.Height := 17 ;\r
580 chbStayOnTop.Caption := 'Stay On Top' ;\r
581 //chbStayOnTop.TabOrder := 8 ;\r
582 chbStayOnTop.OnClick := chbStayOnTopClick;\r
583 end;\r