source: trunk/Sibyl/Addon/COOLBAR.PAS@ 201

Last change on this file since 201 was 7, checked in by RBRi, 19 years ago

+ sibyl staff
  • Property svn:eol-style set to native
File size: 34.7 KB
Line 
1{***********************************************************************
2 * *
3 * This example implements a Win32 IExplore stlye "CoolBar" and also *
4 * shows how to implement a Class property editor *
5 * *
6 * (C) 1998 SpeedSoft *
7 * *
8 ***********************************************************************}
9
10Unit CoolBar;
11
12Interface
13
14Uses Classes,Forms,Graphics,Buttons,StdCtrls,ComCtrls,Dialogs;
15
16Type
17 TCoolSection=Class(THeaderSection)
18 Private
19 FImage:LongInt;
20 FHotImage:LongInt;
21 FDisabledImage:LongInt;
22 FDisabled:Boolean;
23 Private
24 Procedure SetDisabled(NewValue:Boolean);
25 Procedure SetImage(NewValue:LongInt);
26 Procedure SetHotImage(NewValue:LongInt);
27 Procedure SetDisabledImage(NewValue:LongInt);
28 Public
29 Constructor Create(ACollection:TCollection);Override;
30 Procedure Assign(Source:TCollectionItem);Override;
31 Public
32 Property Disabled:Boolean read FDisabled write SetDisabled;
33 Property Image:LongInt read FImage write SetImage;
34 Property HotImage:LongInt read FHotImage write SetHotImage;
35 Property DisabledImage:LongInt read FDisabledImage write SetDisabledImage;
36 End;
37
38 TCoolSections=Class(THeaderSections)
39 Public
40 Procedure SetupComponent;Override;
41 End;
42
43 TDrawCoolSectionEvent=Procedure(HeaderControl:THeaderControl;Section:TCoolSection;
44 Const rc:TRect;Pressed,Hot,Enabled:Boolean) Of Object;
45
46 TCoolBar=Class(THeaderControl)
47 Private
48 FBackgroundBitmap:TBitmap;
49 FActiveSection:TCoolSection;
50 FImages:TImageList;
51 FFlat:Boolean;
52 FBackgroundOffset:LongWord;
53 FMouseTimer:TTimer;
54 FOnDrawSection:TDrawCoolSectionEvent;
55 Private
56 Procedure EvFMouseTimer(Sender:TObject);
57 Procedure SetBackgroundBitmap(NewValue:TBitmap);
58 Procedure UpdateHeader(Header:THeaderSection);Override;
59 Procedure SetImages(NewValue:TImageList);
60 Procedure SetFlat(NewValue:Boolean);
61 Procedure SetBackgroundOffset(NewValue:LongWord);
62 Function GetSections:TCoolSections;
63 Procedure SetSections(NewValue:TCoolSections);
64 Protected
65 Procedure DrawSection(Section:TCoolSection;Const rc:TRect;Pressed,Hot,Enabled:Boolean);Virtual;
66 Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
67 Procedure MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
68 Procedure MouseMove(ShiftState:TShiftState;X,Y:LongInt);Override;
69 Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
70 Public
71 Procedure SetupComponent;Override;
72 Procedure Redraw(Const rec:TRect);Override;
73 Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
74 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
75 Published
76 Property BackgroundBitmap:TBitmap read FBackgroundBitmap write SetBackgroundBitmap;
77 Property BackgroundOffset:LongWord read FBackgroundOffset write SetBackgroundOffset;
78 Property Images:TImageList read FImages write SetImages;
79 Property Flat:Boolean read FFlat write SetFlat;
80 Property Sections:TCoolSections Read GetSections Write SetSections;
81 Published
82 Property OnDrawSection:TDrawCoolSectionEvent Read FOnDrawSection Write FOnDrawSection;
83 End;
84
85Implementation
86
87{$R CoolBar}
88
89{
90ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
91º º
92º Speed-Pascal/2 Version 2.0 º
93º º
94º Speed-Pascal Component Classes (SPCC) º
95º º
96º This section: TCoolSection Class Implementation º
97º º
98º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
99º º
100ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
101}
102
103Constructor TCoolSection.Create(ACollection:TCollection);
104Begin
105 Inherited Create(ACollection);
106 FImage:=-1;
107 FHotImage:=-1;
108 FDisabledImage:=-1;
109End;
110
111Procedure TCoolSection.Assign(Source:TCollectionItem);
112Begin
113 Inherited Assign(Source);
114 If Source Is TCoolSection Then
115 If Source<>Self Then
116 Begin
117 FImage:=TCoolSection(Source).Image;
118 FHotImage:=TCoolSection(Source).HotImage;
119 FDisabledImage:=TCoolSection(Source).DisabledImage;
120 FDisabled:=TCoolSection(Source).Disabled;
121 End;
122End;
123
124Procedure TCoolSection.SetDisabled(NewValue:Boolean);
125Begin
126 If NewValue=FDisabled Then exit;
127 FDisabled:=NewValue;
128 Changed(False);
129End;
130
131Procedure TCoolSection.SetImage(NewValue:LongInt);
132Begin
133 If NewValue=FImage Then exit;
134 FImage:=NewValue;
135 Changed(False);
136End;
137
138Procedure TCoolSection.SetHotImage(NewValue:LongInt);
139Begin
140 If NewValue=FHotImage Then exit;
141 FHotImage:=NewValue;
142 Changed(False);
143End;
144
145Procedure TCoolSection.SetDisabledImage(NewValue:LongInt);
146Begin
147 If NewValue=FDisabledImage Then exit;
148 FDisabledImage:=NewValue;
149 Changed(False);
150End;
151
152{
153ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
154º º
155º Speed-Pascal/2 Version 2.0 º
156º º
157º Speed-Pascal Component Classes (SPCC) º
158º º
159º This section: TCoolSections Class Implementation º
160º º
161º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
162º º
163ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
164}
165
166Procedure TCoolSections.SetupComponent;
167Begin
168 Inherited SetupComponent;
169 Name:='CoolSections';
170 ItemClass:=TCoolSection;
171End;
172
173{
174ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
175º º
176º Speed-Pascal/2 Version 2.0 º
177º º
178º Speed-Pascal Component Classes (SPCC) º
179º º
180º This section: TCoolBar Class Implementation º
181º º
182º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
183º º
184ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
185}
186
187Procedure TCoolBar.SetupComponent;
188Begin
189 Inherited SetupComponent;
190
191 FBackgroundBitmap.Create;
192 FBackgroundBitmap.LoadFromResourceName('Cool');
193 FFlat:=True;
194 FMouseTimer.Create(Self);
195 Include(FMouseTimer.ComponentState, csDetail);
196 FMouseTimer.Interval := 50;
197 FMouseTimer.OnTimer := EvFMouseTimer;
198 Name:='CoolBar';
199 SectionsClass:=TCoolSections;
200End;
201
202Procedure TCoolBar.SetFlat(NewValue:Boolean);
203Begin
204 If NewValue=FFlat Then exit;
205 FFlat:=NewValue;
206 Invalidate;
207End;
208
209Function TCoolBar.GetSections:TCoolSections;
210Begin
211 Result:=TCoolSections(Inherited Sections);
212End;
213
214Procedure TCoolBar.SetSections(NewValue:TCoolSections);
215Begin
216 Inherited Sections:=NewValue;
217End;
218
219
220Procedure TCoolBar.SetImages(NewValue:TImageList);
221Begin
222 If NewValue=FImages Then exit;
223 If FImages<>Nil Then FImages.Notification(Self,opRemove);
224 FImages:=NewValue;
225 If FImages <> Nil Then FImages.FreeNotification(Self);
226 Invalidate;
227End;
228
229Procedure TCoolBar.Notification(AComponent:TComponent;Operation:TOperation);
230Begin
231 Inherited Notification(AComponent,Operation);
232
233 If Operation = opRemove Then
234 If AComponent = FImages Then FImages := Nil;
235End;
236
237
238Procedure TCoolBar.SetBackgroundBitmap(NewValue:TBitmap);
239Begin
240 If NewValue=FBackgroundBitmap Then exit;
241 If FBackgroundBitmap<>Nil Then FBackgroundBitmap.Destroy;
242 If NewValue<>Nil Then FBackgroundBitmap:=NewValue.Copy
243 Else FBackgroundBitmap:=Nil;
244End;
245
246Procedure TCoolBar.SetBackgroundOffset(NewValue:LongWord);
247Begin
248 If NewValue=FBackgroundOffset Then exit;
249 FBackgroundOffset:=NewValue;
250 Invalidate;
251End;
252
253Procedure TCoolBar.DrawSection(Section:TCoolSection;Const rc:TRect;Pressed,Hot,Enabled:Boolean);
254Var
255 Align:TAlignment;
256 S:String;
257 CX,CY,CX1,CY1,H,X,Y:LongInt;
258 rec,bmprec:TRect;
259 PointsArray:Array[0..5] Of TPoint;
260 offs:LongInt;
261 FBitmap,FMask:TBitmap;
262
263 Procedure DrawMasked(Bitmap,Mask:TBitmap;X,Y:LongInt);
264 Var Source,Dest:TRect;
265 Begin
266 If Bitmap=Nil Then exit;
267 Source.Left:=0;
268 Source.Bottom:=0;
269 Dest.Left:=X;
270 Dest.Bottom:=Y;
271
272 If Mask<>Nil Then
273 Begin
274 Source.Right:=Mask.Width;
275 Source.Top:=Mask.Height;
276 Dest.Top:=Dest.Bottom+Mask.Height;
277 Dest.Right:=Dest.Left+Mask.Width;
278 Mask.Canvas.BitBlt(Canvas,Dest,Source,cmSrcAnd,bitfIgnore);
279 End;
280
281 Source.Right:=Bitmap.Width;
282 Source.Top:=Bitmap.Height;
283 Dest.Top:=Dest.Bottom+Bitmap.Height;
284 Dest.Right:=Dest.Left+Bitmap.Width;
285 If Mask<>Nil Then
286 Bitmap.Canvas.BitBlt(Canvas,Dest,Source,cmSrcPaint,bitfIgnore)
287 Else
288 Bitmap.Canvas.BitBlt(Canvas,Dest,Source,cmSrcCopy,bitfIgnore);
289
290 Canvas.ExcludeClipRect(Dest);
291 End;
292
293Begin
294 Align:=section.Alignment;
295 S:=section.Text;
296
297 If S='' Then
298 Begin
299 CX:=0;
300 CY:=0;
301 End
302 Else Canvas.GetTextExtent(S,CX,CY);
303
304 FBitmap:=Nil;
305 FMask:=Nil;
306 If FImages<>Nil Then If FImages.Count>0 Then
307 Begin
308 If not Enabled Then
309 Begin
310 If Section.DisabledImage>=0 Then
311 If FImages.Count>Section.DisabledImage Then
312 Begin
313 FBitmap.Create;
314 FImages.GetBitmap(Section.DisabledImage,FBitmap);
315 FMask.Create;
316 FImages.GetMask(Section.DisabledImage,FMask);
317 End;
318 End
319 Else If Hot Then
320 Begin
321 If Section.HotImage>=0 Then
322 If FImages.Count>Section.HotImage Then
323 Begin
324 FBitmap.Create;
325 FImages.GetBitmap(Section.HotImage,FBitmap);
326 FMask.Create;
327 FImages.GetMask(Section.HotImage,FMask);
328 End;
329 End;
330
331 If FBitmap<>Nil Then If FBitmap.Empty Then
332 Begin
333 FBitmap.Destroy;
334 FBitmap:=Nil;
335 End;
336
337 If FMask<>Nil Then If FMask.Empty Then
338 Begin
339 FMask.Destroy;
340 FMask:=Nil;
341 End;
342
343 If FBitmap=Nil Then
344 Begin
345 If Section.Image>=0 Then
346 If FImages.Count>Section.Image Then
347 Begin
348 FBitmap.Create;
349 FImages.GetBitmap(Section.Image,FBitmap);
350 FMask.Create;
351 FImages.GetMask(Section.Image,FMask);
352 End;
353 End;
354
355 If FBitmap<>Nil Then If FBitmap.Empty Then
356 Begin
357 FBitmap.Destroy;
358 FBitmap:=Nil;
359 End;
360
361 If FMask<>Nil Then If FMask.Empty Then
362 Begin
363 FMask.Destroy;
364 FMask:=Nil;
365 End;
366 End;
367
368 CX1:=CX;
369 CY1:=CY;
370
371 If FBitmap<>Nil Then
372 Begin
373 If Align=taCenter Then inc(CY1,FBitmap.Height+3)
374 Else inc(CX1,FBitmap.Width+3);
375 End;
376
377 Case Align Of
378 taLeftJustify:
379 Begin
380 H:=rc.Right-rc.Left;
381 rec.Left:=rc.Left+((H-CX1) Div 2);
382 End;
383 taRightJustify:
384 Begin
385 H:=rc.Right-rc.Left;
386 rec.Left:=rc.Left+((H-CX1) Div 2);
387 If FBitmap<>Nil Then inc(rec.Left,FBitmap.Width);
388 End
389 Else //taCenter
390 Begin
391 H:=rc.Right-rc.Left;
392 rec.Left:=rc.Left+((H-CX) Div 2);
393 End;
394 End; //Case
395
396 If rec.Left<rc.Left+3 Then rec.Left:=rc.Left+3;
397
398 H:=rc.Top-rc.Bottom;
399 rec.Bottom:=rc.Bottom+((H-CY1) Div 2);
400 If rec.Bottom<rc.Bottom+3 Then rec.Bottom:=rc.Bottom+3;
401 rec.Right:=rec.Left+CX-1;
402 rec.Top:=rec.Bottom+CY-1;
403
404 //Draw Bitmap
405 If FBitmap<>Nil Then
406 Begin
407 H:=rc.Top-rc.Bottom;
408 Y:=rc.Bottom+((H-CY1) Div 2);
409 If Y<rc.Bottom+3 Then Y:=rc.Bottom+3;
410
411 Case Align Of
412 taLeftJustify:
413 Begin
414 DrawMasked(FBitmap,FMask,rec.Right+3,Y);
415 End;
416 taRightJustify:
417 Begin
418 DrawMasked(FBitmap,FMask,rec.Left-3-FBitmap.Width,Y);
419 End;
420 Else //taCenter
421 Begin
422 H:=rc.Right-rc.Left;
423 X:=rc.Left+((H-FBitmap.Width) Div 2);
424 If X<rc.Left+3 Then X:=rc.Left+3;
425 DrawMasked(FBitmap,FMask,X,Y+CY+3);
426 End;
427 End; //Case
428
429 FBitmap.Destroy;
430 If FMask<>Nil Then FMask.Destroy;
431 End;
432
433 If S<>'' Then
434 Begin
435 Canvas.Brush.Mode:=bmTransparent;
436 If not Enabled Then Canvas.Pen.Color:=clDkGray
437 Else Canvas.Pen.Color:=PenColor;
438
439 Canvas.TextOut(rec.Left,rec.Bottom,S);
440 Canvas.Brush.Mode:=bmOpaque;
441
442 Canvas.ExcludeClipRect(rec);
443 End;
444
445 If ((not Flat)Or(Hot And Enabled)) Then
446 Begin
447 If BevelWidth > 1 Then
448 Begin
449 offs := BevelWidth-1;
450 PointsArray[0] := Point(rc.Left,rc.Bottom);
451 PointsArray[1] := Point(rc.Left+offs,rc.Bottom+offs);
452 PointsArray[2] := Point(rc.Left+offs,rc.Top-offs);
453 PointsArray[3] := Point(rc.Right-offs,rc.Top-offs);
454 PointsArray[4] := Point(rc.Right,rc.Top);
455 PointsArray[5] := Point(rc.Left,rc.Top);
456 Canvas.Pen.color := clWhite;
457 Canvas.Polygon(PointsArray);
458 PointsArray[2] := Point(rc.Right-offs,rc.Bottom+offs);
459 PointsArray[3] := Point(rc.Right-offs,rc.Top-offs);
460 PointsArray[4] := Point(rc.Right,rc.Top);
461 PointsArray[5] := Point(rc.Right,rc.Bottom);
462 Canvas.Pen.color := clDkGray;
463 Canvas.Polygon(PointsArray);
464 Canvas.Pen.color:=PenColor;
465 End
466 Else Canvas.ShadowedBorder(rc,clWhite,clDkGray);
467 End;
468End;
469
470Type
471 PHeaderItem=^THeaderItem;
472 THeaderItem=Record
473 Image:LongInt;
474 HotImage:LongInt;
475 DisabledImage:LongInt;
476 Disabled:Boolean;
477 End;
478
479Const rnCoolHeaders='rnCoolHeaders';
480
481Procedure TCoolBar.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
482Var
483 Count:^LongInt;
484 Items:PHeaderItem;
485 section:TCoolSection;
486 T:LongInt;
487 ps:^String;
488Begin
489 If ResName = rnCoolHeaders Then
490 Begin
491 Count:=@Data;
492 Items:=@Data;
493 Inc(Items,4);
494 For T:=1 To Count^ Do
495 Begin
496 Section:=TCoolSection(Sections[t-1]);
497 section.Image:=Items^.Image;
498 section.HotImage:=Items^.HotImage;
499 section.DisabledImage:=Items^.DisabledImage;
500 section.Disabled:=Items^.Disabled;
501 Inc(Items,SizeOf(THeaderItem));
502 End;
503 End
504 Else Inherited ReadSCUResource(ResName,Data,DataLen);
505End;
506
507
508Function TCoolBar.WriteSCUResource(Stream:TResourceStream):Boolean;
509Var MemStream:TMemoryStream;
510 T:LongInt;
511 Item:THeaderItem;
512 section:TCoolSection;
513 S:String;
514Begin
515 Result := Inherited WriteSCUResource(Stream);
516 If Not Result Then Exit;
517
518 If Sections<>Nil Then If Sections.Count>0 Then
519 Begin
520 MemStream.Create;
521 T:=Sections.Count;
522 MemStream.Write(T,4);
523 For T:=0 To Sections.Count-1 Do
524 Begin
525 section:=TCoolSection(Sections[T]);
526 Item.Image:=section.Image;
527 Item.HotImage:=section.HotImage;
528 Item.DisabledImage:=section.DisabledImage;
529 Item.Disabled:=section.Disabled;
530 MemStream.Write(Item,SizeOf(THeaderItem));
531 End;
532
533 Result:=Stream.NewResourceEntry(rnCoolHeaders,MemStream.Memory^,MemStream.Size);
534 MemStream.Destroy;
535 End;
536End;
537
538
539Procedure TCoolBar.Redraw(Const rec:TRect);
540Var X,Y:LongInt;
541 rc,rc2,Src:TRect;
542 FSections:TCoolSections;
543 Section:TCoolSection;
544 IsPressed:Boolean;
545 t,W:LongInt;
546Begin
547 Canvas.ClipRect:=rec;
548
549 If FBackgroundBitmap<>Nil Then
550 Begin
551 Y:=0;
552 While Y<Height Do
553 Begin
554 X:=0;
555 While X<Width Do
556 Begin
557 rc.Left:=X;
558 rc.Right:=rc.Left+FBackgroundBitmap.Width;
559 rc.Bottom:=Y;
560 rc.Top:=rc.Bottom+FBackgroundBitmap.Height;
561 If ((BackgroundOffset<>0)And(Y=0)And(X=0)) Then
562 Begin
563 W:=BackgroundOffset;
564 If W>BackgroundBitmap.Width Then W:=BackgroundBitmap.Width;
565 Src.Left:=W;
566 Src.Bottom:=0;
567 Src.Right:=FBackGroundBitmap.Width;
568 Src.Top:=FBackGroundBitmap.Height;
569 rc.Right:=rc.Left+(BackgroundBitmap.Width-W);
570 FBackgroundBitmap.PartialDraw(Canvas,Src,rc);
571 inc(X,BackgroundBitmap.Width-W);
572 End
573 Else
574 Begin
575 FBackgroundBitmap.Draw(Canvas,rc);
576 inc(X,FBackgroundBitmap.Width);
577 End;
578 End;
579 inc(Y,FBackgroundBitmap.Height);
580 End;
581 End
582 Else Canvas.FillRect(rec,Color);
583
584 FSections:=TCoolSections(Sections);
585 rc:=ClientRect;
586 Inc(rc.Bottom);
587 For T:=0 To FSections.Count-1 Do
588 Begin
589 Section:=TCoolSection(FSections[T]);
590 rc.Right:=rc.Left+section.Width;
591 If rc.Right>Width-1 Then rc.Right:=Width-1;
592
593 IsPressed:=Section=ClickSection;
594 If IsPressed Then
595 Begin
596 Inc(rc.Left);
597 Inc(rc.Right);
598 Dec(rc.Bottom);
599 Dec(rc.Top);
600 End;
601
602 rc2:=Forms.IntersectRect(rc,rec);
603 If Not Forms.IsRectEmpty(rc2) Then
604 Begin
605 inc(rc2.Right);
606 Canvas.ClipRect:=rc2;
607
608 If Section.Style=hsOwnerDraw Then
609 Begin
610 If OnDrawSection<>Nil Then OnDrawSection(Self,section,rc,IsPressed,Section=FActiveSection,Section.Disabled=False)
611 Else DrawSection(Section,rc,IsPressed,Section=FActiveSection,Section.Disabled=False);
612 End
613 Else DrawSection(section,rc,IsPressed,Section=FActiveSection,Section.Disabled=False);
614 End;
615
616 If IsPressed Then
617 Begin
618 Dec(rc.Left);
619 Dec(rc.Right);
620 Inc(rc.Bottom);
621 Inc(rc.Top);
622 End;
623 Inc(rc.Left,Section.Width+Spacing+1);
624 End;
625
626 Canvas.DeleteClipRegion;
627End;
628
629Procedure TCoolBar.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
630Var T:LongInt;
631 section:TCoolSection;
632 FSections:TCoolSections;
633Begin
634 TControl.MouseDown(Button,ShiftState,X,Y);
635
636 If Button <> mbLeft Then Exit;
637
638 FSections:=TCoolSections(Sections);
639 For T:=0 To FSections.Count-1 Do
640 Begin
641 section:=TCoolSection(FSections[T]);
642 If ((section.AllowSize)And(X>section.Right-2)And(X<section.Right+2)) Then
643 Begin
644 Inherited MouseDown(Button,ShiftState,X,Y);
645 exit;
646 End;
647 End;
648
649 If Designed Then Exit;
650
651 //Test Press
652 Section:=TCoolSection(GetMouseHeader(X,Y));
653 If Section<>Nil Then If section.AllowClick Then If not Section.Disabled Then
654 Inherited MouseDown(Button,ShiftState,X,Y);
655End;
656
657Procedure TCoolBar.MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
658Var section:TCoolSection;
659Begin
660 If Button=mbLeft Then
661 Begin
662 Section:=TCoolSection(GetMouseHeader(X,Y));
663 If Section<>Nil Then If section.AllowClick Then If not Section.Disabled Then
664 Inherited MouseDblClick(Button,ShiftState,X,Y);
665 End
666 Else Inherited MouseDblClick(Button,ShiftState,X,Y);
667End;
668
669Procedure TCoolBar.UpdateHeader(Header:THeaderSection);
670Var T:LongInt;
671 rc:TRect;
672 FSections:TCoolSections;
673Begin
674 //Get Rectangle For the Panel
675 rc:=ClientRect;
676 FSections:=TCoolSections(Sections);
677 For T:=0 To FSections.Count-1 Do
678 Begin
679 If FSections[T]=Header Then break
680 Else Inc(rc.Left,FSections[T].Width+Spacing+1);
681 End;
682
683 rc.Right:=rc.Left+Header.Width+1;
684 If not Flat Then InflateRect(rc,-BevelWidth*2,-BevelWidth*2);
685 InvalidateRect(rc);
686 Update;
687End;
688
689
690Procedure TCoolBar.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
691Var
692 Section,OldActiveSection:TCoolSection;
693Begin
694 FMouseTimer.Stop;
695
696 OldActiveSection:=FActiveSection;
697 Section:=TCoolSection(GetMouseHeader(X,Y));
698 If ((Section=Nil)Or(not Section.Disabled)) Then FActiveSection:=Section;
699
700 Inherited MouseMove(ShiftState,X,Y);
701
702 If FActiveSection<>OldActiveSection Then
703 Begin
704 If OldActiveSection<>Nil Then UpdateHeader(OldActiveSection);
705 If FActiveSection<>Nil Then UpdateHeader(FActiveSection);
706 End;
707
708 If FFlat Then FMouseTimer.Start;
709End;
710
711
712Procedure TCoolBar.EvFMouseTimer(Sender:TObject);
713Var
714 AControl:TControl;
715 OldActiveSection:TCoolSection;
716Begin
717 FMouseTimer.Stop;
718
719 AControl := Screen.GetControlFromPoint(Screen.MousePos);
720
721 If AControl <> Self Then
722 Begin
723 OldActiveSection:=FActiveSection;
724 FActiveSection := Nil;
725 If OldActiveSection<>Nil Then UpdateHeader(OldActiveSection);
726 End
727 Else FMouseTimer.Start;
728End;
729
730{
731ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
732º º
733º Sibyl Version 2.0 º
734º º
735º This section: TCoolSectionsPropertyEditor Class implementation º
736º º
737º º
738ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
739}
740
741Type
742 TCoolSectionsPropertyEditor=Class(TClassPropertyEditor)
743 Public
744 Function Execute(Var ClassToEdit:TObject):TClassPropertyEditorReturn;Override;
745 End;
746
747 TCoolSectionsPropEditDialog=Class(TDialog)
748 Private
749 FSections:TCoolSections;
750 FListBox:TListBox;
751 FText:TEdit;
752 FWidth:TEdit;
753 FMinWidth,FMaxWidth:TEdit;
754 FImage,FHotImage,FDisabledImage:TEdit;
755 FStyle:TComboBox;
756 FAlignment:TComboBox;
757 FCurrentSection:TCoolSection;
758 FCurrentIndex:LongInt;
759 FAllowClick:TCheckBox;
760 FAllowSize:TCheckBox;
761 FDisabled:TCheckBox;
762 Protected
763 Procedure SetupComponent;Override;
764 Procedure NewClicked(Sender:TObject);
765 Procedure DeleteClicked(Sender:TObject);
766 Procedure UpdateClicked(Sender:TObject);
767 Procedure ListItemFocus(Sender:TObject;Index:LongInt);
768 Procedure StoreItem;
769 Procedure TextChange(Sender:TObject);
770 Procedure WidthChange(Sender:TObject);
771 Procedure MinWidthChange(Sender:TObject);
772 Procedure MaxWidthChange(Sender:TObject);
773 Procedure ImageChange(Sender:TObject);
774 Procedure HotImageChange(Sender:TObject);
775 Procedure DisabledClick(Sender:TObject);
776 Procedure DisabledImageChange(Sender:TObject);
777 Procedure StyleSelect(Sender:TObject;Index:LongInt);
778 Procedure AlignmentSelect(Sender:TObject;Index:LongInt);
779 End;
780
781
782{$HINTS OFF}
783Procedure TCoolSectionsPropEditDialog.TextChange(Sender:TObject);
784Begin
785 If FCurrentSection=Nil Then exit;
786 FCurrentSection.Text:=FText.Text;
787End;
788
789Procedure TCoolSectionsPropEditDialog.WidthChange(Sender:TObject);
790Var i:LongInt;
791 c:Integer;
792Begin
793 If FCurrentSection=Nil Then exit;
794 VAL(FWidth.Text,i,c);
795 If c<>0 Then exit;
796 FCurrentSection.Width:=i;
797End;
798
799Procedure TCoolSectionsPropEditDialog.MinWidthChange(Sender:TObject);
800Var i:LongInt;
801 c:Integer;
802Begin
803 If FCurrentSection=Nil Then exit;
804 VAL(FMinWidth.Text,i,c);
805 If c<>0 Then exit;
806 FCurrentSection.MinWidth:=i;
807End;
808
809Procedure TCoolSectionsPropEditDialog.MaxWidthChange(Sender:TObject);
810Var i:LongInt;
811 c:Integer;
812Begin
813 If FCurrentSection=Nil Then exit;
814 VAL(FMaxWidth.Text,i,c);
815 If c<>0 Then exit;
816 FCurrentSection.MaxWidth:=i;
817End;
818
819Procedure TCoolSectionsPropEditDialog.DisabledClick(Sender:TObject);
820Begin
821 If FCurrentSection=Nil Then exit;
822 FCurrentSection.Disabled:=FDisabled.Checked;
823End;
824
825Procedure TCoolSectionsPropEditDialog.ImageChange(Sender:TObject);
826Var i:LongInt;
827 c:Integer;
828Begin
829 If FCurrentSection=Nil Then exit;
830 VAL(FImage.Text,i,c);
831 If c<>0 Then exit;
832 FCurrentSection.Image:=i;
833End;
834
835Procedure TCoolSectionsPropEditDialog.HotImageChange(Sender:TObject);
836Var i:LongInt;
837 c:Integer;
838Begin
839 If FCurrentSection=Nil Then exit;
840 VAL(FHotImage.Text,i,c);
841 If c<>0 Then exit;
842 FCurrentSection.HotImage:=i;
843End;
844
845Procedure TCoolSectionsPropEditDialog.DisabledImageChange(Sender:TObject);
846Var i:LongInt;
847 c:Integer;
848Begin
849 If FCurrentSection=Nil Then exit;
850 VAL(FDisabledImage.Text,i,c);
851 If c<>0 Then exit;
852 FCurrentSection.DisabledImage:=i;
853End;
854
855
856Procedure TCoolSectionsPropEditDialog.StyleSelect(Sender:TObject;Index:LongInt);
857Begin
858 If FCurrentSection=Nil Then exit;
859 If FStyle.Text='OwnerDraw' Then FCurrentSection.Style:=hsOwnerDraw
860 Else FCurrentSection.Style:=hsText;
861End;
862
863Procedure TCoolSectionsPropEditDialog.AlignmentSelect(Sender:TObject;Index:LongInt);
864Begin
865 If FCurrentSection=Nil Then exit;
866 If FAlignment.Text='Center' Then FCurrentSection.Alignment:=taCenter
867 Else If FAlignment.Text='Right justify' Then FCurrentSection.Alignment:=taRightJustify
868 Else FCurrentSection.Alignment:=taLeftJustify;
869End;
870
871Procedure TCoolSectionsPropEditDialog.UpdateClicked(Sender:TObject);
872Begin
873 StoreItem;
874 FSections.Update(Nil);
875End;
876
877Procedure TCoolSectionsPropEditDialog.NewClicked(Sender:TObject);
878Var Section:THeaderSection;
879Begin
880 Section:=FSections.Add;
881 If Section.Text='' Then FListBox.Items.Add(tostr(Section.Index)+' - (Untitled)')
882 Else FListBox.Items.Add(tostr(Section.Index)+' - '+Section.Text);
883 FListBox.ItemIndex:=Section.Index;
884 FSections.Update(Nil);
885End;
886
887Procedure TCoolSectionsPropEditDialog.DeleteClicked(Sender:TObject);
888Var Section:THeaderSection;
889 Index:LongInt;
890Begin
891 Index:=FListBox.ItemIndex;
892 If Index<0 Then exit;
893 FListBox.Items.Delete(Index);
894 Section:=FSections[Index];
895 Section.Destroy;
896 FCurrentSection:=Nil;
897 FCurrentIndex:=-1;
898 If FListBox.Items.Count>0 Then FListBox.ItemIndex:=0;
899End;
900{$HINTS ON}
901
902Procedure TCoolSectionsPropEditDialog.StoreItem;
903Var c:Integer;
904 i:LongInt;
905Begin
906 If FCurrentSection<>Nil Then //store values
907 Begin
908 FCurrentSection.Text:=FText.Text;
909 If FText.Text='' Then FListBox.Items[FCurrentIndex]:=tostr(FCurrentIndex)+' - (Untitled)'
910 Else FListBox.Items[FCurrentIndex]:=tostr(FCurrentIndex)+' - '+FText.Text;
911
912 VAL(FWidth.Text,i,c);
913 If c<>0 Then i:=100;
914 FCurrentSection.Width:=i;
915
916 VAL(FMinWidth.Text,i,c);
917 If c<>0 Then i:=0;
918 FCurrentSection.MinWidth:=i;
919
920 VAL(FMaxWidth.Text,i,c);
921 If c<>0 Then i:=10000;
922 FCurrentSection.MaxWidth:=i;
923
924 VAL(FImage.Text,i,c);
925 If c<>0 Then i:=10000;
926 FCurrentSection.Image:=i;
927
928 VAL(FHotImage.Text,i,c);
929 If c<>0 Then i:=10000;
930 FCurrentSection.HotImage:=i;
931
932 VAL(FDisabledImage.Text,i,c);
933 If c<>0 Then i:=10000;
934 FCurrentSection.DisabledImage:=i;
935
936 FCurrentSection.Disabled:=FDisabled.Checked;
937
938 If FStyle.Text='OwnerDraw' Then FCurrentSection.Style:=hsOwnerDraw
939 Else FCurrentSection.Style:=hsText;
940
941 If FAlignment.Text='Center' Then FCurrentSection.Alignment:=taCenter
942 Else If FAlignment.Text='Right justify' Then FCurrentSection.Alignment:=taRightJustify
943 Else FCurrentSection.Alignment:=taLeftJustify;
944
945 FCurrentSection.AllowClick:=FAllowClick.Checked;
946 FCurrentSection.AllowSize:=FAllowSize.Checked;
947 End;
948End;
949
950Procedure TCoolSectionsPropEditDialog.ListItemFocus(Sender:TObject;Index:LongInt);
951Begin
952 StoreItem;
953
954 FCurrentSection:=TCoolSection(FSections[Index]);
955 FCurrentIndex:=Index;
956 FText.Text:=FCurrentSection.Text;
957 FWidth.Text:=tostr(FCurrentSection.Width);
958 FMinWidth.Text:=tostr(FCurrentSection.MinWidth);
959 FMaxWidth.Text:=tostr(FCurrentSection.MaxWidth);
960 FImage.Text:=tostr(FCurrentSection.Image);
961 FHotImage.Text:=tostr(FCurrentSection.HotImage);
962 FDisabledImage.Text:=tostr(FCurrentSection.DisabledImage);
963 FDisabled.Checked:=FCurrentSection.Disabled;
964 If FCurrentSection.Style=hsText Then FStyle.Text:='Text'
965 Else FStyle.Text:='OwnerDraw';
966
967 Case FCurrentSection.Alignment Of
968 taRightJustify:FAlignment.Text:='Right justify';
969 taCenter:FAlignment.Text:='Center';
970 Else FAlignment.Text:='Left justify';
971 End;
972
973 FAllowClick.Checked:=FCurrentSection.AllowClick;
974 FAllowSize.Checked:=FCurrentSection.AllowSize;
975End;
976
977Procedure TCoolSectionsPropEditDialog.SetupComponent;
978Var Button:TButton;
979 ComboBox:TComboBox;
980Begin
981 Inherited SetupComponent;
982
983 Caption:='CoolBar sections editor';
984 Width:=445;
985 Height:=380;
986
987 InsertGroupBox(Self,10,50,180,290,'Sections');
988 FListBox:=InsertListBox(Self,20,100,160,220,'');
989 FListBox.OnItemFocus:=ListItemFocus;
990
991 Button:=InsertButton(Self,20,60,70,30,'New','New Section');
992 Button.OnClick:=NewClicked;
993 Button:=InsertButton(Self,100,60,70,30,'Delete','Delete Section');
994 Button.OnClick:=DeleteClicked;
995
996 InsertGroupBox(Self,200,50,230,290,'Section Properties');
997
998 InsertLabel(Self,210,290,50,20,'Text');
999 FText:=InsertEdit(Self,280,295,140,20,'','');
1000 FText.OnChange:=TextChange;
1001
1002 InsertLabel(Self,210,260,100,20,'Width');
1003 FWidth:=InsertEdit(Self,280,265,140,20,'','');
1004 FWidth.OnChange:=WidthChange;
1005 FWidth.NumbersOnly:=TRUE;
1006
1007 InsertLabel(Self,210,230,60,20,'Min/Max');
1008 FMinWidth:=InsertEdit(Self,280,235,65,20,'','');
1009 FMinWidth.OnChange:=MinWidthChange;
1010 FMinWidth.NumbersOnly:=TRUE;
1011 FMaxWidth:=InsertEdit(Self,355,235,65,20,'','');
1012 FMaxWidth.OnChange:=MaxWidthChange;
1013 FMaxWidth.NumbersOnly:=TRUE;
1014
1015 InsertLabel(Self,210,200,100,20,'Style');
1016 FStyle:=InsertComboBox(Self,280,205,140,20,csDropDownList);
1017 FStyle.Items.Add('Text');
1018 FStyle.Items.Add('OwnerDraw');
1019 FStyle.OnItemSelect:=StyleSelect;
1020
1021 InsertLabel(Self,210,170,100,20,'Alignment');
1022 FAlignment:=InsertComboBox(Self,280,175,140,20,csDropDownList);
1023 FAlignment.Items.Add('Left justify');
1024 FAlignment.Items.Add('Right justify');
1025 FAlignment.Items.Add('Center');
1026 FAlignment.OnItemSelect:=AlignmentSelect;
1027
1028 FAllowClick:=InsertCheckBox(Self,210,135,100,20,'Allow Click','');
1029 FAllowSize:=InsertCheckBox(Self,210,115,100,20,'Allow Size','');
1030 FDisabled:=InsertCheckBox(Self,210,95,100,20,'Disabled','');
1031 FDisabled.OnClick:=DisabledClick;
1032
1033 InsertLabel(Self,300,133,100,20,'Image');
1034 FImage:=InsertEdit(Self,400,138,20,20,'','');
1035 FImage.OnChange:=ImageChange;
1036 FImage.NumbersOnly:=TRUE;
1037
1038 InsertLabel(Self,300,113,100,20,'HotImage');
1039 FHotImage:=InsertEdit(Self,400,118,20,20,'','');
1040 FHotImage.OnChange:=HotImageChange;
1041 FHotImage.NumbersOnly:=TRUE;
1042
1043 InsertLabel(Self,300,93,100,20,'DisabledImage');
1044 FDisabledImage:=InsertEdit(Self,400,98,20,20,'','');
1045 FDisabledImage.OnChange:=DisabledImageChange;
1046 FDisabledImage.NumbersOnly:=TRUE;
1047
1048 Button:=InsertButton(Self,210,60,200,30,'Update','Update Section');
1049 Button.OnClick:=UpdateClicked;
1050
1051 InsertBitBtn(Self,10,10,90,30,bkOk,'~Ok','Click here to accept');
1052 InsertBitBtn(Self,110,10,90,30,bkCancel,'~Cancel','Click here to cancel');
1053 InsertBitBtn(Self,210,10,90,30,bkHelp,'~Help','Click here to get help');
1054End;
1055
1056Function TCoolSectionsPropertyEditor.Execute(Var ClassToEdit:TObject):TClassPropertyEditorReturn;
1057Var HeaderSections:TCoolSections;
1058 FDialog:TCoolSectionsPropEditDialog;
1059 SaveHeaders:TCoolSections;
1060 Section:TCoolSection;
1061 t:LongInt;
1062Begin
1063 HeaderSections:=TCoolSections(ClassToEdit);
1064 If HeaderSections.HeaderControl=Nil Then
1065 Begin
1066 result:=peNoEditor;
1067 exit;
1068 End;
1069
1070 SaveHeaders.Create(Nil);
1071 SaveHeaders.Assign(HeaderSections);
1072
1073 FDialog.Create(Nil);
1074 FDialog.FSections:=HeaderSections;
1075
1076 For t:=0 TO HeaderSections.Count-1 Do
1077 Begin
1078 Section:=TCoolSection(HeaderSections[t]);
1079 If Section.Text='' Then FDialog.FListBox.Items.Add(tostr(t)+' - (Untitled)')
1080 Else FDialog.FListBox.Items.Add(tostr(t)+' - '+Section.Text);
1081 End;
1082 If FDialog.FListBox.Items.Count>0 Then FDialog.FListBox.ItemIndex:=0;
1083
1084 FDialog.ShowModal;
1085
1086 //Modify ClassToEdit here
1087 result:=peCancel;
1088 Case FDialog.ModalResult Of
1089 cmOk:
1090 Begin
1091 FDialog.StoreItem;
1092 result:=peOk;
1093 End;
1094 Else
1095 Begin
1096 HeaderSections.Assign(SaveHeaders);
1097 result:=peCancel;
1098 End;
1099 End; {Case}
1100
1101 SaveHeaders.Destroy;
1102 FDialog.Destroy;
1103End;
1104
1105Initialization
1106 RegisterClasses([TCoolBar]);
1107 //Register property editor
1108 AddClassPropertyEditor(TCoolSections,TCoolSectionsPropertyEditor);
1109End.
Note: See TracBrowser for help on using the repository browser.