1 | Unit CustomHeaderControl;
|
---|
2 |
|
---|
3 | // Modified Header control.
|
---|
4 | // Improved and simplified drawing of sections
|
---|
5 | // ... ReadSCUResource clears the sections list
|
---|
6 | // Copied property editor from IDE code. Since translation
|
---|
7 | // is too confusing converted to english only.
|
---|
8 | Interface
|
---|
9 |
|
---|
10 | Uses
|
---|
11 | Messages,Classes,Forms,Graphics,Buttons,ExtCtrls,Dos;
|
---|
12 |
|
---|
13 | Type
|
---|
14 | TCustomHeaderSectionsPropertyEditor=CLASS(TClassPropertyEditor)
|
---|
15 | PUBLIC
|
---|
16 | FUNCTION Execute(VAR ClassToEdit:TObject):TClassPropertyEditorReturn;OVERRIDE;
|
---|
17 | END;
|
---|
18 |
|
---|
19 |
|
---|
20 | TCustomHeaderControl=Class;
|
---|
21 |
|
---|
22 | {$M+}
|
---|
23 | TCustomHeaderSectionStyle=(hsText,hsOwnerDraw);
|
---|
24 | {$M-}
|
---|
25 |
|
---|
26 | TCustomHeaderSection=Class(TCollectionItem)
|
---|
27 | Private
|
---|
28 | FText:PString;
|
---|
29 | FWidth:LongInt;
|
---|
30 | FMinWidth:LongInt;
|
---|
31 | FMaxWidth:LongInt;
|
---|
32 | FAlignment:TAlignment;
|
---|
33 | FStyle:TCustomHeaderSectionStyle;
|
---|
34 | FAllowClick:Boolean;
|
---|
35 | FAllowSize:Boolean;
|
---|
36 | Private
|
---|
37 | Function GetText:String;
|
---|
38 | Procedure SetText(Const NewValue:String);
|
---|
39 | Procedure SetWidth(NewValue:LongInt);
|
---|
40 | Function GetLeft:LongInt;
|
---|
41 | Function GetRight:LongInt;
|
---|
42 | Procedure SetStyle(NewValue:TCustomHeaderSectionStyle);
|
---|
43 | Procedure SetAlignment(NewValue:TAlignment);
|
---|
44 | Procedure SetMaxWidth(NewValue:LongInt);
|
---|
45 | Procedure SetMinWidth(NewValue:LongInt);
|
---|
46 | Public
|
---|
47 | Constructor Create(ACollection:TCollection);Override;
|
---|
48 | Destructor Destroy;Override;
|
---|
49 | Procedure Assign(Source:TCollectionItem);Override;
|
---|
50 | Public
|
---|
51 | Property Left:LongInt Read GetLeft;
|
---|
52 | Property Right:LongInt Read GetRight;
|
---|
53 | Published
|
---|
54 | Property Text:String Read GetText Write SetText;
|
---|
55 | Property Width:LongInt Read FWidth Write SetWidth;
|
---|
56 | Property MinWidth:LongInt Read FMinWidth Write SetMinWidth;
|
---|
57 | Property MaxWidth:LongInt Read FMaxWidth Write SetMaxWidth;
|
---|
58 | Property Alignment:TAlignment Read FAlignment Write SetAlignment;
|
---|
59 | Property AllowClick:Boolean Read FAllowClick Write FAllowClick;
|
---|
60 | Property AllowSize:Boolean Read FAllowSize Write FAllowSize;
|
---|
61 | Property Style:TCustomHeaderSectionStyle Read FStyle Write SetStyle;
|
---|
62 | End;
|
---|
63 |
|
---|
64 | {$HINTS OFF}
|
---|
65 | TCustomHeaderSections=Class(TCollection)
|
---|
66 | Private
|
---|
67 | FHeaderControl:TCustomHeaderControl;
|
---|
68 | Function GetItem(Index:LongInt):TCustomHeaderSection;
|
---|
69 | Procedure SetItem(Index:LongInt;NewValue:TCustomHeaderSection);
|
---|
70 | Public
|
---|
71 | Procedure Update(Item:TCollectionItem);Override;
|
---|
72 | Procedure SetupComponent;Override;
|
---|
73 | Function Add:TCustomHeaderSection;
|
---|
74 | Public
|
---|
75 | Property Items[Index:LongInt]:TCustomHeaderSection Read GetItem Write SetItem;Default;
|
---|
76 | Property HeaderControl:TCustomHeaderControl Read FHeaderControl;
|
---|
77 | End;
|
---|
78 | {$HINTS ON}
|
---|
79 | TCustomHeaderSectionsClass=Class Of TCustomHeaderSections;
|
---|
80 |
|
---|
81 | {$M+}
|
---|
82 | TSectionTrackState=(tsTrackBegin,tsTrackMove,tsTrackEnd);
|
---|
83 |
|
---|
84 | TCustomHeaderSectionNotifyEvent=Procedure(HeaderControl:TCustomHeaderControl;section:TCustomHeaderSection) Of Object;
|
---|
85 | TDrawSectionEvent=Procedure(HeaderControl:TCustomHeaderControl;section:TCustomHeaderSection;
|
---|
86 | Const rc:TRect;Pressed:Boolean) Of Object;
|
---|
87 | TSectionTrackEvent=Procedure(HeaderControl:TCustomHeaderControl;section:TCustomHeaderSection;
|
---|
88 | Width:LongInt;State:TSectionTrackState) Of Object;
|
---|
89 |
|
---|
90 | TCustomHeaderControl=Class(TControl)
|
---|
91 | Private
|
---|
92 | FSections:TCustomHeaderSections;
|
---|
93 | FSpacing:LongInt;
|
---|
94 | FOnDrawSection:TDrawSectionEvent;
|
---|
95 | FOnSectionClick:TCustomHeaderSectionNotifyEvent;
|
---|
96 | FOnSectionResize:TCustomHeaderSectionNotifyEvent;
|
---|
97 | FOnSectionTrack:TSectionTrackEvent;
|
---|
98 | FSectionTrackState:TSectionTrackState;
|
---|
99 | FClickSection:TCustomHeaderSection;
|
---|
100 | FClickBase:TCustomHeaderSection;
|
---|
101 | FSizeStartX:LongInt;
|
---|
102 | FSizeX:LongInt;
|
---|
103 | FSizeSection:TCustomHeaderSection;
|
---|
104 | FBevelWidth:LongInt;
|
---|
105 | FShape:TCursor;
|
---|
106 | FSectionsClass:TCustomHeaderSectionsClass;
|
---|
107 | Private
|
---|
108 | Procedure SetSections(NewValue:TCustomHeaderSections);
|
---|
109 | Procedure SetSpacing(NewValue:LongInt);
|
---|
110 | Procedure SetBevelWidth(NewValue:LongInt);
|
---|
111 | Function GetSections:TCustomHeaderSections;
|
---|
112 | Protected
|
---|
113 | Function GetMouseHeader(X,Y:LongInt):TCustomHeaderSection;Virtual;
|
---|
114 | Procedure UpdateHeader(Header:TCustomHeaderSection);Virtual;
|
---|
115 | Procedure DrawSection(section:TCustomHeaderSection;Const rc:TRect;Pressed:Boolean);Virtual;
|
---|
116 | Procedure SectionClick(section:TCustomHeaderSection);Virtual;
|
---|
117 | Procedure SectionResize(section:TCustomHeaderSection);Virtual;
|
---|
118 | Procedure SectionTrack(section:TCustomHeaderSection;Width:LongInt;State:TSectionTrackState);Virtual;
|
---|
119 | Procedure SetupComponent;Override;
|
---|
120 | Destructor Destroy;Override;
|
---|
121 | Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
|
---|
122 | Procedure MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
|
---|
123 | Procedure MouseMove(ShiftState:TShiftState;X,Y:LongInt);Override;
|
---|
124 | Procedure MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
|
---|
125 | Protected
|
---|
126 | Property ClickSection:TCustomHeaderSection read FClickSection write FClickSection;
|
---|
127 | Public
|
---|
128 | Procedure Redraw(Const rec:TRect);Override;
|
---|
129 | Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
|
---|
130 | Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
|
---|
131 | Public
|
---|
132 | Property SectionsClass:TCustomHeaderSectionsClass read FSectionsClass write FSectionsClass;
|
---|
133 | Published
|
---|
134 | Property Align;
|
---|
135 | Property BevelWidth:LongInt Read FBevelWidth Write SetBevelWidth;
|
---|
136 | Property DragCursor;
|
---|
137 | Property DragMode;
|
---|
138 | Property Enabled;
|
---|
139 | Property Font;
|
---|
140 | Property Sections:TCustomHeaderSections Read GetSections Write SetSections;
|
---|
141 | Property ShowHint;
|
---|
142 | Property ParentFont;
|
---|
143 | Property ParentShowHint;
|
---|
144 | Property PopupMenu;
|
---|
145 | Property Spacing:LongInt Read FSpacing Write SetSpacing;
|
---|
146 | Property TabOrder;
|
---|
147 | Property TabStop;
|
---|
148 | Property OnDragDrop;
|
---|
149 | Property OnDragOver;
|
---|
150 | Property OnStartDrag;
|
---|
151 | Property OnEndDrag;
|
---|
152 | Property OnMouseDown;
|
---|
153 | Property OnMouseMove;
|
---|
154 | Property OnMouseUp;
|
---|
155 | Property OnSectionClick:TCustomHeaderSectionNotifyEvent Read FOnSectionClick Write FOnSectionClick;
|
---|
156 | Property OnDrawSection:TDrawSectionEvent Read FOnDrawSection Write FOnDrawSection;
|
---|
157 | Property OnSectionResize:TCustomHeaderSectionNotifyEvent Read FOnSectionResize Write FOnSectionResize;
|
---|
158 | Property OnSectionTrack:TSectionTrackEvent Read FOnSectionTrack Write FOnSectionTrack;
|
---|
159 | End;
|
---|
160 |
|
---|
161 | exports
|
---|
162 | TCustomHeaderControl, 'User', 'CustomHeaderControl.bmp';
|
---|
163 |
|
---|
164 | Implementation
|
---|
165 |
|
---|
166 | Uses
|
---|
167 | PmWin, Dialogs, StdCtrls, SysUtils;
|
---|
168 |
|
---|
169 | procedure DrawBevel( Canvas: TCanvas;
|
---|
170 | BevelRc: TRect;
|
---|
171 | BevelWidth: longint;
|
---|
172 | Sunken: boolean );
|
---|
173 | var
|
---|
174 | offs: longint;
|
---|
175 | PointsArray: Array[0..5] Of TPoint;
|
---|
176 | OldPenColor: TColor;
|
---|
177 | begin
|
---|
178 | If BevelWidth > 1 Then
|
---|
179 | Begin
|
---|
180 | OldPenColor:= Canvas.Pen.Color;
|
---|
181 | offs := BevelWidth-1;
|
---|
182 | PointsArray[0] := Point(bevelrc.Left,bevelrc.Bottom);
|
---|
183 | PointsArray[1] := Point(bevelrc.Left+offs,bevelrc.Bottom+offs);
|
---|
184 | PointsArray[2] := Point(bevelrc.Left+offs,bevelrc.Top-offs);
|
---|
185 | PointsArray[3] := Point(bevelrc.Right-offs,bevelrc.Top-offs);
|
---|
186 | PointsArray[4] := Point(bevelrc.Right,bevelrc.Top);
|
---|
187 | PointsArray[5] := Point(bevelrc.Left,bevelrc.Top);
|
---|
188 | if Sunken then
|
---|
189 | Canvas.Pen.color := clDkGray
|
---|
190 | else
|
---|
191 | Canvas.Pen.color := clWhite;
|
---|
192 | Canvas.Polygon(PointsArray);
|
---|
193 | PointsArray[2] := Point(bevelrc.Right-offs,bevelrc.Bottom+offs);
|
---|
194 | PointsArray[3] := Point(bevelrc.Right-offs,bevelrc.Top-offs);
|
---|
195 | PointsArray[4] := Point(bevelrc.Right,bevelrc.Top);
|
---|
196 | PointsArray[5] := Point(bevelrc.Right,bevelrc.Bottom);
|
---|
197 | if Sunken then
|
---|
198 | Canvas.Pen.color := clWhite
|
---|
199 | else
|
---|
200 | Canvas.Pen.color := clDkGray;
|
---|
201 | Canvas.Polygon(PointsArray);
|
---|
202 | Canvas.Pen.color:= OldPenColor;
|
---|
203 | End
|
---|
204 | Else
|
---|
205 | if Sunken then
|
---|
206 | Canvas.ShadowedBorder(bevelrc,clDkGray,clWhite)
|
---|
207 | else
|
---|
208 | Canvas.ShadowedBorder(bevelrc,clWhite,clDkGray);
|
---|
209 | end;
|
---|
210 |
|
---|
211 |
|
---|
212 | {
|
---|
213 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
214 | º º
|
---|
215 | º Speed-Pascal/2 Version 2.0 º
|
---|
216 | º º
|
---|
217 | º Speed-Pascal Component Classes (SPCC) º
|
---|
218 | º º
|
---|
219 | º This section: TCustomHeaderControl Class Implementation º
|
---|
220 | º º
|
---|
221 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
222 | º º
|
---|
223 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
224 | }
|
---|
225 |
|
---|
226 | Function TCustomHeaderSection.GetText:String;
|
---|
227 | Begin
|
---|
228 | If FText<>Nil Then Result:=FText^
|
---|
229 | Else Result:='';
|
---|
230 | End;
|
---|
231 |
|
---|
232 | Procedure TCustomHeaderSection.SetText(Const NewValue:String);
|
---|
233 | Begin
|
---|
234 | If FText<>Nil Then
|
---|
235 | Begin
|
---|
236 | If FText^=NewValue Then Exit;
|
---|
237 | FreeMem(FText,Length(FText^)+1);
|
---|
238 | End;
|
---|
239 | GetMem(FText,Length(NewValue)+1);
|
---|
240 | FText^:=NewValue;
|
---|
241 | changed(False);
|
---|
242 | End;
|
---|
243 |
|
---|
244 | Procedure TCustomHeaderSection.SetWidth(NewValue:LongInt);
|
---|
245 | Begin
|
---|
246 | If NewValue<FMinWidth Then NewValue:=FMinWidth;
|
---|
247 | If NewValue>FMaxWidth Then NewValue:=FMaxWidth;
|
---|
248 | If NewValue=FWidth Then Exit;
|
---|
249 | FWidth:=NewValue;
|
---|
250 | changed(True);
|
---|
251 | End;
|
---|
252 |
|
---|
253 | Function TCustomHeaderSection.GetLeft:LongInt;
|
---|
254 | Var T:LongInt;
|
---|
255 | Sections:TCustomHeaderSections;
|
---|
256 | Begin
|
---|
257 | Result:=0;
|
---|
258 | Sections:=TCustomHeaderSections(collection);
|
---|
259 | If Sections<>Nil Then For T:=0 To Index-1 Do
|
---|
260 | Begin
|
---|
261 | Inc(Result,Sections[T].Width);
|
---|
262 | If Sections.FHeaderControl<>Nil Then Inc(Result,Sections.FHeaderControl.FSpacing);
|
---|
263 | End;
|
---|
264 | End;
|
---|
265 |
|
---|
266 | Function TCustomHeaderSection.GetRight:LongInt;
|
---|
267 | Begin
|
---|
268 | Result:=Left+Width;
|
---|
269 | End;
|
---|
270 |
|
---|
271 | Procedure TCustomHeaderSection.SetStyle(NewValue:TCustomHeaderSectionStyle);
|
---|
272 | Begin
|
---|
273 | If NewValue=FStyle Then Exit;
|
---|
274 | FStyle:=NewValue;
|
---|
275 | changed(False);
|
---|
276 | End;
|
---|
277 |
|
---|
278 | Procedure TCustomHeaderSection.SetAlignment(NewValue:TAlignment);
|
---|
279 | Begin
|
---|
280 | If NewValue=FAlignment Then Exit;
|
---|
281 | FAlignment:=NewValue;
|
---|
282 | changed(False);
|
---|
283 | End;
|
---|
284 |
|
---|
285 | Procedure TCustomHeaderSection.SetMaxWidth(NewValue:LongInt);
|
---|
286 | Begin
|
---|
287 | If NewValue>10000 Then NewValue:=10000;
|
---|
288 | If NewValue<FMinWidth Then NewValue:=FMinWidth;
|
---|
289 | FMaxWidth:=NewValue;
|
---|
290 | Width:=FWidth; //Update
|
---|
291 | End;
|
---|
292 |
|
---|
293 | Procedure TCustomHeaderSection.SetMinWidth(NewValue:LongInt);
|
---|
294 | Begin
|
---|
295 | If NewValue<0 Then NewValue:=0;
|
---|
296 | If NewValue>FMaxWidth Then NewValue:=FMaxWidth;
|
---|
297 | FMinWidth:=NewValue;
|
---|
298 | Width:=FWidth; //Update
|
---|
299 | End;
|
---|
300 |
|
---|
301 | Constructor TCustomHeaderSection.Create(ACollection:TCollection);
|
---|
302 | Begin
|
---|
303 | FWidth:=100;
|
---|
304 | FMinWidth:=0;
|
---|
305 | FMaxWidth:=10000;
|
---|
306 | FAlignment:=taLeftJustify;
|
---|
307 | FStyle:=hsText;
|
---|
308 | FAllowClick:=True;
|
---|
309 | FAllowSize:=True;
|
---|
310 | Inherited Create(ACollection);
|
---|
311 | End;
|
---|
312 |
|
---|
313 | Destructor TCustomHeaderSection.Destroy;
|
---|
314 | Begin
|
---|
315 | If FText<>Nil Then FreeMem(FText,Length(FText^)+1);
|
---|
316 |
|
---|
317 | Inherited Destroy;
|
---|
318 | End;
|
---|
319 |
|
---|
320 | Procedure TCustomHeaderSection.Assign(Source:TCollectionItem);
|
---|
321 | Begin
|
---|
322 | If Source Is TCustomHeaderSection Then
|
---|
323 | If Source<>Self Then
|
---|
324 | Begin
|
---|
325 | FMinWidth:=TCustomHeaderSection(Source).MinWidth;
|
---|
326 | FMaxWidth:=TCustomHeaderSection(Source).MaxWidth;
|
---|
327 | FAlignment:=TCustomHeaderSection(Source).Alignment;
|
---|
328 | FStyle:=TCustomHeaderSection(Source).Style;
|
---|
329 | FAllowClick:=TCustomHeaderSection(Source).AllowClick;
|
---|
330 | FAllowSize:=TCustomHeaderSection(Source).AllowSize;
|
---|
331 | Width:=TCustomHeaderSection(Source).Width;
|
---|
332 | Text:=TCustomHeaderSection(Source).Text;
|
---|
333 | End;
|
---|
334 | End;
|
---|
335 |
|
---|
336 | {
|
---|
337 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
338 | º º
|
---|
339 | º Speed-Pascal/2 Version 2.0 º
|
---|
340 | º º
|
---|
341 | º Speed-Pascal Component Classes (SPCC) º
|
---|
342 | º º
|
---|
343 | º This section: TCustomHeaderSections Class Implementation º
|
---|
344 | º º
|
---|
345 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
346 | º º
|
---|
347 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
348 | }
|
---|
349 |
|
---|
350 | Function TCustomHeaderSections.GetItem(Index:LongInt):TCustomHeaderSection;
|
---|
351 | Var dummy:TCollectionItem;
|
---|
352 | Begin
|
---|
353 | dummy:=Inherited GetItem(Index);
|
---|
354 | Result:=TCustomHeaderSection(dummy);
|
---|
355 | End;
|
---|
356 |
|
---|
357 | Procedure TCustomHeaderSections.SetItem(Index:LongInt;NewValue:TCustomHeaderSection);
|
---|
358 | Begin
|
---|
359 | Inherited SetItem(Index,NewValue);
|
---|
360 | End;
|
---|
361 |
|
---|
362 | Procedure TCustomHeaderSections.Update(Item:TCollectionItem);
|
---|
363 | Begin
|
---|
364 | If FHeaderControl=Nil Then Exit;
|
---|
365 | If Item=Nil Then FHeaderControl.Invalidate
|
---|
366 | Else FHeaderControl.UpdateHeader(TCustomHeaderSection(Item));
|
---|
367 | End;
|
---|
368 |
|
---|
369 | Procedure TCustomHeaderSections.SetupComponent;
|
---|
370 | Begin
|
---|
371 | Inherited SetupComponent;
|
---|
372 |
|
---|
373 | Name:='HeaderSections';
|
---|
374 | If Owner Is TCustomHeaderControl Then FHeaderControl:=TCustomHeaderControl(Owner);
|
---|
375 | ItemClass:=TCustomHeaderSection;
|
---|
376 | End;
|
---|
377 |
|
---|
378 | Function TCustomHeaderSections.Add:TCustomHeaderSection;
|
---|
379 | Var dummy:TCollectionItem;
|
---|
380 | Begin
|
---|
381 | dummy:=Inherited Add;
|
---|
382 | Result:=TCustomHeaderSection(dummy);
|
---|
383 | End;
|
---|
384 |
|
---|
385 | {
|
---|
386 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
387 | º º
|
---|
388 | º Speed-Pascal/2 Version 2.0 º
|
---|
389 | º º
|
---|
390 | º Speed-Pascal Component Classes (SPCC) º
|
---|
391 | º º
|
---|
392 | º This section: TCustomHeaderControl Class Implementation º
|
---|
393 | º º
|
---|
394 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
395 | º º
|
---|
396 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
397 | }
|
---|
398 |
|
---|
399 | Function TCustomHeaderControl.GetSections:TCustomHeaderSections;
|
---|
400 | Begin
|
---|
401 | If FSections=Nil Then FSections:=FSectionsClass.Create(Self);
|
---|
402 | Result:=FSections;
|
---|
403 | End;
|
---|
404 |
|
---|
405 | Procedure TCustomHeaderControl.SetSections(NewValue:TCustomHeaderSections);
|
---|
406 | Begin
|
---|
407 | Sections.Assign(NewValue);
|
---|
408 | End;
|
---|
409 |
|
---|
410 | Procedure TCustomHeaderControl.UpdateHeader(Header:TCustomHeaderSection);
|
---|
411 | Var T:LongInt;
|
---|
412 | rc:TRect;
|
---|
413 | Begin
|
---|
414 | //Get Rectangle For the Panel
|
---|
415 | rc:=ClientRect;
|
---|
416 | If FSections<>Nil Then
|
---|
417 | For T:=0 To FSections.Count-1 Do
|
---|
418 | Begin
|
---|
419 | If FSections[T]=Header Then break
|
---|
420 | Else Inc(rc.Left,FSections[T].Width+FSpacing);
|
---|
421 | End;
|
---|
422 |
|
---|
423 | rc.Right:=rc.Left+Header.Width;
|
---|
424 | InvalidateRect(rc);
|
---|
425 | Update;
|
---|
426 | End;
|
---|
427 |
|
---|
428 | {$HINTS OFF}
|
---|
429 | Procedure TCustomHeaderControl.DrawSection(section:TCustomHeaderSection;Const rc:TRect;Pressed:Boolean);
|
---|
430 | Var
|
---|
431 | Align:TAlignment;
|
---|
432 | S:String;
|
---|
433 | CX,CY,H:LongInt;
|
---|
434 | rec:TRect;
|
---|
435 | Begin
|
---|
436 | Align:=section.Alignment;
|
---|
437 | S:=section.Text;
|
---|
438 |
|
---|
439 | Canvas.GetTextExtent(S,CX,CY);
|
---|
440 |
|
---|
441 | Case Align Of
|
---|
442 | taLeftJustify:
|
---|
443 | rec.Left:=rc.Left+3;
|
---|
444 | taRightJustify:
|
---|
445 | rec.Left:=rc.Right-3-CX;
|
---|
446 | Else //taCenter
|
---|
447 | Begin
|
---|
448 | H:=rc.Right-rc.Left;
|
---|
449 | rec.Left:=rc.Left+((H-CX) Div 2);
|
---|
450 | End;
|
---|
451 | End; //Case
|
---|
452 |
|
---|
453 | If rec.Left<rc.Left+3 Then
|
---|
454 | rec.Left:=rc.Left+3;
|
---|
455 | if Pressed then
|
---|
456 | inc( rec.Left );
|
---|
457 | H:=rc.Top-rc.Bottom;
|
---|
458 | rec.Bottom:=rc.Bottom+((H-CY) Div 2);
|
---|
459 | If rec.Bottom<rc.Bottom+3 Then rec.Bottom:=rc.Bottom+3;
|
---|
460 | if Pressed then
|
---|
461 | dec( rec.Bottom );
|
---|
462 | rec.Right:=rec.Left+CX-1;
|
---|
463 | rec.Top:=rec.Bottom+CY-1;
|
---|
464 |
|
---|
465 | Canvas.TextOut(rec.Left,rec.Bottom,S);
|
---|
466 |
|
---|
467 | Canvas.ExcludeClipRect(rec);
|
---|
468 |
|
---|
469 | DrawBevel( Canvas, rc, BevelWidth, Pressed );
|
---|
470 |
|
---|
471 | rec:=rc;
|
---|
472 | Forms.InflateRect(rec,-BevelWidth,-BevelWidth);
|
---|
473 | Canvas.FillRect(rec,Color)
|
---|
474 | End;
|
---|
475 | {$HINTS ON}
|
---|
476 |
|
---|
477 |
|
---|
478 | Procedure TCustomHeaderControl.Redraw(Const rec:TRect);
|
---|
479 | Var T:LongInt;
|
---|
480 | rc,rc2:TRect;
|
---|
481 | section:TCustomHeaderSection;
|
---|
482 | IsPressed:Boolean;
|
---|
483 | Begin
|
---|
484 | Canvas.Brush.color:=color;
|
---|
485 | Canvas.Pen.color:=PenColor;
|
---|
486 |
|
---|
487 | rc:=ClientRect;
|
---|
488 | If FSections<>Nil Then
|
---|
489 | begin
|
---|
490 | For T:=0 To FSections.Count-1 Do
|
---|
491 | Begin
|
---|
492 | section:=FSections[T];
|
---|
493 | rc.Right:=rc.Left+section.Width -1;
|
---|
494 |
|
---|
495 | If rc.Right>Width-1 Then
|
---|
496 | rc.Right:=Width-1;
|
---|
497 |
|
---|
498 | if T = FSections.Count - 1 then
|
---|
499 | // always expand last column to width
|
---|
500 | rc.Right:=Width-1;
|
---|
501 |
|
---|
502 | IsPressed:= section = FClickSection;
|
---|
503 |
|
---|
504 | rc2:=Forms.IntersectRect(rc,rec);
|
---|
505 | If Not Forms.IsRectEmpty(rc2) Then
|
---|
506 | Begin
|
---|
507 | Canvas.ClipRect:=rc2;
|
---|
508 |
|
---|
509 | If section.Style=hsOwnerDraw Then
|
---|
510 | Begin
|
---|
511 | If OnDrawSection<>Nil Then OnDrawSection(Self,section,rc,IsPressed)
|
---|
512 | Else DrawSection(section,rc,IsPressed);
|
---|
513 | End
|
---|
514 | Else DrawSection(section,rc,IsPressed);
|
---|
515 | End;
|
---|
516 |
|
---|
517 |
|
---|
518 | Inc( rc.Left, section.Width );
|
---|
519 | if FSpacing > 0 then
|
---|
520 | begin
|
---|
521 | rc.Right:= rc.Left + FSpacing ;
|
---|
522 | Canvas.FillRect( rc, Color );
|
---|
523 | Inc( rc.Left, FSpacing );
|
---|
524 | end;
|
---|
525 | if rc.Left > Width then
|
---|
526 | break;
|
---|
527 | End;
|
---|
528 |
|
---|
529 | if FSections.COunt = 0 then
|
---|
530 | begin
|
---|
531 | // No sections
|
---|
532 | Canvas.ClipRect:=rc;
|
---|
533 | DrawBevel( Canvas, rc, BevelWidth, false );
|
---|
534 | InflateRect( rc, -BevelWidth, -BevelWidth );
|
---|
535 | Canvas.FillRect( rc, COlor );
|
---|
536 | end;
|
---|
537 |
|
---|
538 | end;
|
---|
539 |
|
---|
540 | Canvas.DeleteClipRegion;
|
---|
541 | End;
|
---|
542 |
|
---|
543 | Type
|
---|
544 | PHeaderItem=^THeaderItem;
|
---|
545 | THeaderItem=Record
|
---|
546 | Style:TCustomHeaderSectionStyle;
|
---|
547 | Width:LongInt;
|
---|
548 | MinWidth,MaxWidth:LongInt;
|
---|
549 | AllowClick,AllowSize:Boolean;
|
---|
550 | Alignment:TAlignment;
|
---|
551 | End;
|
---|
552 |
|
---|
553 |
|
---|
554 | Procedure TCustomHeaderControl.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
|
---|
555 | Var
|
---|
556 | Count:^LongInt;
|
---|
557 | Items:PHeaderItem;
|
---|
558 | section:TCustomHeaderSection;
|
---|
559 | T:LongInt;
|
---|
560 | ps:^String;
|
---|
561 | Begin
|
---|
562 | If ResName = rnHeaders Then
|
---|
563 | Begin
|
---|
564 | Sections.Clear;
|
---|
565 | Count:=@Data;
|
---|
566 | Items:=@Data;
|
---|
567 | Inc(Items,4);
|
---|
568 | For T:=1 To Count^ Do
|
---|
569 | Begin
|
---|
570 | Section:=Sections.Add;
|
---|
571 | ps:=Pointer(Items);
|
---|
572 | section.Text:=ps^;
|
---|
573 | Inc(Items,Length(ps^)+1);
|
---|
574 | section.Style:=Items^.Style;
|
---|
575 | section.Alignment:=Items^.Alignment;
|
---|
576 | section.Width:=Items^.Width;
|
---|
577 | section.MinWidth:=Items^.MinWidth;
|
---|
578 | section.MaxWidth:=Items^.MaxWidth;
|
---|
579 | section.AllowClick:=Items^.AllowClick;
|
---|
580 | section.AllowSize:=Items^.AllowSize;
|
---|
581 | Inc(Items,SizeOf(THeaderItem));
|
---|
582 | End;
|
---|
583 | End
|
---|
584 | Else Inherited ReadSCUResource(ResName,Data,DataLen);
|
---|
585 | End;
|
---|
586 |
|
---|
587 |
|
---|
588 | Function TCustomHeaderControl.WriteSCUResource(Stream:TResourceStream):Boolean;
|
---|
589 | Var MemStream:TMemoryStream;
|
---|
590 | T:LongInt;
|
---|
591 | Item:THeaderItem;
|
---|
592 | section:TCustomHeaderSection;
|
---|
593 | S:String;
|
---|
594 | Begin
|
---|
595 | Result := Inherited WriteSCUResource(Stream);
|
---|
596 | If Not Result Then Exit;
|
---|
597 |
|
---|
598 | If FSections<>Nil Then If FSections.Count>0 Then
|
---|
599 | Begin
|
---|
600 | MemStream.Create;
|
---|
601 | T:=FSections.Count;
|
---|
602 | MemStream.Write(T,4);
|
---|
603 | For T:=0 To FSections.Count-1 Do
|
---|
604 | Begin
|
---|
605 | section:=FSections[T];
|
---|
606 | S:=section.Text;
|
---|
607 | MemStream.Write(S,Length(S)+1);
|
---|
608 | Item.Style:=section.Style;
|
---|
609 | Item.Width:=section.Width;
|
---|
610 | Item.MinWidth:=section.MinWidth;
|
---|
611 | Item.MaxWidth:=section.MaxWidth;
|
---|
612 | Item.AllowClick:=section.AllowClick;
|
---|
613 | Item.AllowSize:=section.AllowSize;
|
---|
614 | Item.Alignment:=section.Alignment;
|
---|
615 | MemStream.Write(Item,SizeOf(THeaderItem));
|
---|
616 | End;
|
---|
617 |
|
---|
618 | Result:=Stream.NewResourceEntry(rnHeaders,MemStream.Memory^,MemStream.Size);
|
---|
619 | MemStream.Destroy;
|
---|
620 | End;
|
---|
621 | End;
|
---|
622 |
|
---|
623 | Procedure TCustomHeaderControl.SectionClick(section:TCustomHeaderSection);
|
---|
624 | Begin
|
---|
625 | If FOnSectionClick<>Nil Then FOnSectionClick(Self,section);
|
---|
626 | End;
|
---|
627 |
|
---|
628 | Procedure TCustomHeaderControl.SectionResize(section:TCustomHeaderSection);
|
---|
629 | Begin
|
---|
630 | If FOnSectionResize<>Nil Then FOnSectionResize(Self,section);
|
---|
631 | End;
|
---|
632 |
|
---|
633 | Procedure TCustomHeaderControl.SectionTrack(section:TCustomHeaderSection;Width:LongInt;State:TSectionTrackState);
|
---|
634 | Begin
|
---|
635 | If FOnSectionTrack<>Nil Then FOnSectionTrack(Self,section,Width,State);
|
---|
636 | End;
|
---|
637 |
|
---|
638 | Procedure TCustomHeaderControl.SetSpacing(NewValue:LongInt);
|
---|
639 | Begin
|
---|
640 | If NewValue<0 Then NewValue:=0;
|
---|
641 | FSpacing:=NewValue;
|
---|
642 | Invalidate;
|
---|
643 | End;
|
---|
644 |
|
---|
645 | Procedure TCustomHeaderControl.SetBevelWidth(NewValue:LongInt);
|
---|
646 | Begin
|
---|
647 | If NewValue<1 Then NewValue:=1;
|
---|
648 | If NewValue>20 Then NewValue:=20;
|
---|
649 | FBevelWidth:=NewValue;
|
---|
650 | Invalidate;
|
---|
651 | End;
|
---|
652 |
|
---|
653 | Procedure TCustomHeaderControl.SetupComponent;
|
---|
654 | Begin
|
---|
655 | Inherited SetupComponent;
|
---|
656 |
|
---|
657 | Align:=alTop;
|
---|
658 | color:=clDlgWindow;
|
---|
659 | Name:='HeaderControl';
|
---|
660 | FSectionsClass:=TCustomHeaderSections;
|
---|
661 | Height:=50;
|
---|
662 | FSpacing:=0;
|
---|
663 | FSectionTrackState:=tsTrackEnd;
|
---|
664 | FBevelWidth:=1;
|
---|
665 | HandlesDesignMouse:=True;
|
---|
666 | Include(ComponentState,csAcceptsControls);
|
---|
667 | FShape:=crDefault;
|
---|
668 | End;
|
---|
669 |
|
---|
670 | Destructor TCustomHeaderControl.Destroy;
|
---|
671 | Begin
|
---|
672 | If FSections<>Nil Then FSections.Destroy;
|
---|
673 | Inherited Destroy;
|
---|
674 | End;
|
---|
675 |
|
---|
676 | Procedure TCustomHeaderControl.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
|
---|
677 | Var T:LongInt;
|
---|
678 | section:TCustomHeaderSection;
|
---|
679 | Begin
|
---|
680 | Inherited MouseDown(Button,ShiftState,X,Y);
|
---|
681 |
|
---|
682 | If Button <> mbLeft Then Exit;
|
---|
683 |
|
---|
684 | If FSections<>Nil Then For T:=0 To FSections.Count-1 Do
|
---|
685 | Begin
|
---|
686 | section:=FSections[T];
|
---|
687 | If ((section.AllowSize)And(X>section.Right-2)And(X<section.Right+2)) Then
|
---|
688 | Begin
|
---|
689 | Cursor:=crHSplit;
|
---|
690 | FShape:=crHSplit;
|
---|
691 | LastMsg.Handled:=True; {dont pass To Form Editor}
|
---|
692 | Canvas.Pen.Mode:=pmNot;
|
---|
693 | Canvas.Pen.color:=clBlack;
|
---|
694 | FSizeSection:=section;
|
---|
695 | FSizeStartX:=section.Right;
|
---|
696 | FSizeX:=FSizeStartX;
|
---|
697 | Canvas.Line(FSizeX,0,FSizeX,Height);
|
---|
698 | MouseCapture:=True;
|
---|
699 | Canvas.Pen.Mode:=pmCopy;
|
---|
700 | FSectionTrackState:=tsTrackBegin;
|
---|
701 | If OnSectionTrack<>Nil Then OnSectionTrack(Self,FSizeSection,FSizeX-FSizeSection.Left,
|
---|
702 | FSectionTrackState);
|
---|
703 | Exit;
|
---|
704 | End;
|
---|
705 | End;
|
---|
706 |
|
---|
707 | If Designed Then Exit;
|
---|
708 |
|
---|
709 | //Test Press
|
---|
710 | section:=GetMouseHeader(X,Y);
|
---|
711 | If section<>Nil Then If section.AllowClick Then
|
---|
712 | Begin
|
---|
713 | FClickBase:=section;
|
---|
714 | FClickSection:=section;
|
---|
715 | UpdateHeader(section);
|
---|
716 | MouseCapture:=True;
|
---|
717 | End;
|
---|
718 | End;
|
---|
719 |
|
---|
720 | Function TCustomHeaderControl.GetMouseHeader(X,Y:LongInt):TCustomHeaderSection;
|
---|
721 | Var T:LongInt;
|
---|
722 | section:TCustomHeaderSection;
|
---|
723 | Begin
|
---|
724 | Result:=Nil;
|
---|
725 | If FSections<>Nil Then For T:=0 To FSections.Count-1 Do
|
---|
726 | Begin
|
---|
727 | section:=FSections[T];
|
---|
728 | If ((Y>1)And(Y<Height-1)And(X>section.Left+1)And(X<section.Right-1)) Then
|
---|
729 | Begin
|
---|
730 | Result:=section;
|
---|
731 | Exit;
|
---|
732 | End;
|
---|
733 | End;
|
---|
734 | End;
|
---|
735 |
|
---|
736 | Procedure TCustomHeaderControl.MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
|
---|
737 | Var section:TCustomHeaderSection;
|
---|
738 | Begin
|
---|
739 | Inherited MouseDblClick(Button,ShiftState,X,Y);
|
---|
740 |
|
---|
741 | If Button=mbLeft Then
|
---|
742 | Begin
|
---|
743 | section:=GetMouseHeader(X,Y);
|
---|
744 | If section<>Nil Then If section.AllowClick Then
|
---|
745 | Begin
|
---|
746 | FClickSection:=section;
|
---|
747 | UpdateHeader(section);
|
---|
748 | Delay(20);
|
---|
749 | FClickSection:=Nil;
|
---|
750 | UpdateHeader(section);
|
---|
751 | If OnSectionClick<>Nil Then OnSectionClick(Self,section);
|
---|
752 | End;
|
---|
753 | End;
|
---|
754 | End;
|
---|
755 |
|
---|
756 | Procedure TCustomHeaderControl.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
|
---|
757 | Var ClickHeader:TCustomHeaderSection;
|
---|
758 | Begin
|
---|
759 | Inherited MouseUp(Button,ShiftState,X,Y);
|
---|
760 |
|
---|
761 | If Button <> mbLeft Then Exit;
|
---|
762 |
|
---|
763 | If FSectionTrackState In [tsTrackBegin,tsTrackMove] Then
|
---|
764 | Begin
|
---|
765 | LastMsg.Handled:=True; {dont pass To Form Editor}
|
---|
766 | Canvas.Pen.Mode:=pmNot;
|
---|
767 | Canvas.Pen.color:=clBlack;
|
---|
768 | {Delete old rubberline}
|
---|
769 | Canvas.Line(FSizeX,0,FSizeX,Height);
|
---|
770 | MouseCapture:=False;
|
---|
771 | Cursor:=crDefault;
|
---|
772 | FShape:=crDefault;
|
---|
773 | Canvas.Pen.Mode:=pmCopy;
|
---|
774 |
|
---|
775 | If FSizeX<FSizeSection.Left Then FSizeX:=FSizeSection.Left;
|
---|
776 |
|
---|
777 | FSizeSection.Width:=FSizeX-FSizeSection.Left;
|
---|
778 |
|
---|
779 | FSectionTrackState:=tsTrackEnd;
|
---|
780 | If OnSectionTrack<>Nil Then OnSectionTrack(Self,FSizeSection,FSizeSection.Width,
|
---|
781 | FSectionTrackState);
|
---|
782 | If OnSectionResize<>Nil Then
|
---|
783 | OnSectionResize(Self,FSizeSection);
|
---|
784 | FSizeSection:=Nil;
|
---|
785 | End;
|
---|
786 |
|
---|
787 | If FClickBase<>Nil Then
|
---|
788 | Begin
|
---|
789 | ClickHeader:=GetMouseHeader(X,Y);
|
---|
790 | MouseCapture:=False;
|
---|
791 | If ClickHeader=FClickBase Then //clicked
|
---|
792 | Begin
|
---|
793 | FClickSection:=Nil;
|
---|
794 | FClickBase:=Nil;
|
---|
795 | UpdateHeader(ClickHeader);
|
---|
796 | If OnSectionClick<>Nil Then OnSectionClick(Self,ClickHeader);
|
---|
797 | End
|
---|
798 | Else
|
---|
799 | Begin
|
---|
800 | ClickHeader:=FClickBase;
|
---|
801 | FClickSection:=Nil;
|
---|
802 | FClickBase:=Nil;
|
---|
803 | UpdateHeader(ClickHeader);
|
---|
804 | End;
|
---|
805 | End;
|
---|
806 | End;
|
---|
807 |
|
---|
808 | Procedure TCustomHeaderControl.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
|
---|
809 | Var T:LongInt;
|
---|
810 | section:TCustomHeaderSection;
|
---|
811 | Begin
|
---|
812 | Inherited MouseMove(ShiftState,X,Y);
|
---|
813 |
|
---|
814 | If FSectionTrackState In [tsTrackBegin,tsTrackMove] Then
|
---|
815 | Begin
|
---|
816 | LastMsg.Handled:=True; {dont pass To Form Editor}
|
---|
817 | Canvas.Pen.Mode:=pmNot;
|
---|
818 | Canvas.Pen.color:=clBlack;
|
---|
819 | {Delete old rubberline}
|
---|
820 | Canvas.Line(FSizeX,0,FSizeX,Height);
|
---|
821 | {Draw New Line}
|
---|
822 | FSizeX:=X;
|
---|
823 | If FSizeX<FSizeSection.Left Then FSizeX:=FSizeSection.Left;
|
---|
824 | If FSizeX>=Width Then FSizeX:=Width;
|
---|
825 | Canvas.Line(FSizeX,0,FSizeX,Height);
|
---|
826 | Canvas.Pen.Mode:=pmCopy;
|
---|
827 |
|
---|
828 | FSectionTrackState:=tsTrackMove;
|
---|
829 | If OnSectionTrack<>Nil Then OnSectionTrack(Self,FSizeSection,FSizeX-FSizeSection.Left,
|
---|
830 | FSectionTrackState);
|
---|
831 | Exit;
|
---|
832 | End
|
---|
833 | Else
|
---|
834 | Begin
|
---|
835 | If FClickBase<>Nil Then
|
---|
836 | Begin
|
---|
837 | section:=GetMouseHeader(X,Y);
|
---|
838 | If section<>FClickSection Then
|
---|
839 | Begin
|
---|
840 | If FClickSection<>Nil Then
|
---|
841 | Begin
|
---|
842 | section:=FClickSection;
|
---|
843 | FClickSection:=Nil;
|
---|
844 | If section<>Nil Then UpdateHeader(section);
|
---|
845 | End
|
---|
846 | Else
|
---|
847 | Begin
|
---|
848 | If section=FClickBase Then
|
---|
849 | Begin
|
---|
850 | FClickSection:=section;
|
---|
851 | If FClickSection<>Nil Then UpdateHeader(FClickSection);
|
---|
852 | End;
|
---|
853 | End;
|
---|
854 | End;
|
---|
855 | End
|
---|
856 | Else
|
---|
857 | Begin
|
---|
858 | If FSections<>Nil Then For T:=0 To FSections.Count-1 Do
|
---|
859 | Begin
|
---|
860 | section:=FSections[T];
|
---|
861 | If ((section.AllowSize)And(X>section.Right-2)And(X<section.Right+2)) Then
|
---|
862 | Begin
|
---|
863 | FShape:=crHSplit;
|
---|
864 | {$IFDEF OS2}
|
---|
865 | WinSetPointer(HWND_DESKTOP,Screen.Cursors[FShape]);
|
---|
866 | {$ENDIF}
|
---|
867 | {$IFDEF Win95}
|
---|
868 | SetClassWord(Handle,-12{GCW_HCURSOR},0);
|
---|
869 | SetCursor(Screen.Cursors[FShape]);
|
---|
870 | {$ENDIF}
|
---|
871 | LastMsg.Handled:=True; {dont pass To Form Editor}
|
---|
872 | Exit;
|
---|
873 | End;
|
---|
874 | End;
|
---|
875 | End;
|
---|
876 | End;
|
---|
877 |
|
---|
878 | If FShape<>crDefault Then
|
---|
879 | Begin
|
---|
880 | FShape:=crDefault;
|
---|
881 |
|
---|
882 | {$IFDEF OS2}
|
---|
883 | WinSetPointer(HWND_DESKTOP,Screen.Cursors[FShape]);
|
---|
884 | {$ENDIF}
|
---|
885 | {$IFDEF Win95}
|
---|
886 | SetClassWord(Handle,-12{GCW_HCURSOR},0);
|
---|
887 | SetCursor(Screen.Cursors[FShape]);
|
---|
888 | {$ENDIF}
|
---|
889 | End;
|
---|
890 | End;
|
---|
891 |
|
---|
892 | {
|
---|
893 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
894 | º º
|
---|
895 | º Speed-Pascal/2 Version 2.0 º
|
---|
896 | º º
|
---|
897 | º This section: THeaderSectionsPropertyEditor Class implementation º
|
---|
898 | º º
|
---|
899 | º Last modified: September 1995 º
|
---|
900 | º º
|
---|
901 | º (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
902 | º º
|
---|
903 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
904 | }
|
---|
905 |
|
---|
906 | TYPE
|
---|
907 | TCustomHeaderSectionsPropEditDialog=CLASS(TDialog)
|
---|
908 | PRIVATE
|
---|
909 | FSections:TCustomHeaderSections;
|
---|
910 | FListBox:TListBox;
|
---|
911 | FText:TEdit;
|
---|
912 | FWidth:TEdit;
|
---|
913 | FMinWidth,FMaxWidth:TEdit;
|
---|
914 | FStyle:TComboBox;
|
---|
915 | FAlignment:TComboBox;
|
---|
916 | FCurrentSection:TCustomHeaderSection;
|
---|
917 | FCurrentIndex:LONGINT;
|
---|
918 | FAllowClick:TCheckBox;
|
---|
919 | FAllowSize:TCheckBox;
|
---|
920 | PROTECTED
|
---|
921 | PROCEDURE SetupComponent;OVERRIDE;
|
---|
922 | PROCEDURE NewClicked(Sender:TObject);
|
---|
923 | PROCEDURE DeleteClicked(Sender:TObject);
|
---|
924 | PROCEDURE UpdateClicked(Sender:TObject);
|
---|
925 | PROCEDURE ListItemFocus(Sender:TObject;Index:LONGINT);
|
---|
926 | PROCEDURE StoreItem;
|
---|
927 | PROCEDURE TextChange(Sender:TObject);
|
---|
928 | PROCEDURE WidthChange(Sender:TObject);
|
---|
929 | PROCEDURE MinWidthChange(Sender:TObject);
|
---|
930 | PROCEDURE MaxWidthChange(Sender:TObject);
|
---|
931 | PROCEDURE StyleSelect(Sender:TObject;Index:LONGINT);
|
---|
932 | PROCEDURE AlignmentSelect(Sender:TObject;Index:LONGINT);
|
---|
933 | END;
|
---|
934 |
|
---|
935 |
|
---|
936 | {$HINTS OFF}
|
---|
937 | PROCEDURE TCustomHeaderSectionsPropEditDialog.TextChange(Sender:TObject);
|
---|
938 | BEGIN
|
---|
939 | IF FCurrentSection=NIL THEN exit;
|
---|
940 | FCurrentSection.Text:=FText.Text;
|
---|
941 | END;
|
---|
942 |
|
---|
943 | PROCEDURE TCustomHeaderSectionsPropEditDialog.WidthChange(Sender:TObject);
|
---|
944 | VAR i:LONGINT;
|
---|
945 | c:Integer;
|
---|
946 | BEGIN
|
---|
947 | IF FCurrentSection=NIL THEN exit;
|
---|
948 | VAL(FWidth.Text,i,c);
|
---|
949 | IF c<>0 THEN exit;
|
---|
950 | FCurrentSection.Width:=i;
|
---|
951 | END;
|
---|
952 |
|
---|
953 | PROCEDURE TCustomHeaderSectionsPropEditDialog.MinWidthChange(Sender:TObject);
|
---|
954 | VAR i:LONGINT;
|
---|
955 | c:Integer;
|
---|
956 | BEGIN
|
---|
957 | IF FCurrentSection=NIL THEN exit;
|
---|
958 | VAL(FMinWidth.Text,i,c);
|
---|
959 | IF c<>0 THEN exit;
|
---|
960 | FCurrentSection.MinWidth:=i;
|
---|
961 | END;
|
---|
962 |
|
---|
963 | PROCEDURE TCustomHeaderSectionsPropEditDialog.MaxWidthChange(Sender:TObject);
|
---|
964 | VAR i:LONGINT;
|
---|
965 | c:Integer;
|
---|
966 | BEGIN
|
---|
967 | IF FCurrentSection=NIL THEN exit;
|
---|
968 | VAL(FMaxWidth.Text,i,c);
|
---|
969 | IF c<>0 THEN exit;
|
---|
970 | FCurrentSection.MaxWidth:=i;
|
---|
971 | END;
|
---|
972 |
|
---|
973 |
|
---|
974 | PROCEDURE TCustomHeaderSectionsPropEditDialog.StyleSelect(Sender:TObject;Index:LONGINT);
|
---|
975 | BEGIN
|
---|
976 | IF FCurrentSection=NIL THEN exit;
|
---|
977 | IF FStyle.Text='OwnerDraw' THEN FCurrentSection.Style:=hsOwnerDraw
|
---|
978 | ELSE FCurrentSection.Style:=hsText;
|
---|
979 | END;
|
---|
980 |
|
---|
981 | PROCEDURE TCustomHeaderSectionsPropEditDialog.AlignmentSelect(Sender:TObject;Index:LONGINT);
|
---|
982 | BEGIN
|
---|
983 | IF FCurrentSection=NIL THEN exit;
|
---|
984 | IF FAlignment.Text='Center' THEN FCurrentSection.Alignment:=taCenter
|
---|
985 | ELSE IF FAlignment.Text='Right justify' THEN FCurrentSection.Alignment:=taRightJustify
|
---|
986 | ELSE FCurrentSection.Alignment:=taLeftJustify;
|
---|
987 | END;
|
---|
988 |
|
---|
989 | PROCEDURE TCustomHeaderSectionsPropEditDialog.UpdateClicked(Sender:TObject);
|
---|
990 | BEGIN
|
---|
991 | StoreItem;
|
---|
992 | FSections.Update(NIL);
|
---|
993 | END;
|
---|
994 |
|
---|
995 | PROCEDURE TCustomHeaderSectionsPropEditDialog.NewClicked(Sender:TObject);
|
---|
996 | VAR Section:TCustomHeaderSection;
|
---|
997 | BEGIN
|
---|
998 | Section:=FSections.Add;
|
---|
999 | IF Section.Text='' THEN FListBox.Items.Add(tostr(Section.Index)+' - (Untitled)')
|
---|
1000 | ELSE FListBox.Items.Add(tostr(Section.Index)+' - '+Section.Text);
|
---|
1001 | FListBox.ItemIndex:=Section.Index;
|
---|
1002 | FSections.Update(NIL);
|
---|
1003 | END;
|
---|
1004 |
|
---|
1005 | PROCEDURE TCustomHeaderSectionsPropEditDialog.DeleteClicked(Sender:TObject);
|
---|
1006 | VAR Section:TCustomHeaderSection;
|
---|
1007 | Index:LONGINT;
|
---|
1008 | BEGIN
|
---|
1009 | Index:=FListBox.ItemIndex;
|
---|
1010 | IF Index<0 THEN exit;
|
---|
1011 | FListBox.Items.Delete(Index);
|
---|
1012 | Section:=FSections[Index];
|
---|
1013 | Section.Destroy;
|
---|
1014 | FCurrentSection:=NIL;
|
---|
1015 | FCurrentIndex:=-1;
|
---|
1016 | IF FListBox.Items.Count>0 THEN FListBox.ItemIndex:=0;
|
---|
1017 | END;
|
---|
1018 | {$HINTS ON}
|
---|
1019 |
|
---|
1020 | PROCEDURE TCustomHeaderSectionsPropEditDialog.StoreItem;
|
---|
1021 | VAR c:Integer;
|
---|
1022 | i:LONGINT;
|
---|
1023 | BEGIN
|
---|
1024 | IF FCurrentSection<>NIL THEN //store values
|
---|
1025 | BEGIN
|
---|
1026 | FCurrentSection.Text:=FText.Text;
|
---|
1027 | IF FText.Text='' THEN FListBox.Items[FCurrentIndex]:=tostr(FCurrentIndex)+' - (Untitled)'
|
---|
1028 | ELSE FListBox.Items[FCurrentIndex]:=tostr(FCurrentIndex)+' - '+FText.Text;
|
---|
1029 |
|
---|
1030 | VAL(FWidth.Text,i,c);
|
---|
1031 | IF c<>0 THEN i:=100;
|
---|
1032 | FCurrentSection.Width:=i;
|
---|
1033 |
|
---|
1034 | VAL(FMinWidth.Text,i,c);
|
---|
1035 | IF c<>0 THEN i:=0;
|
---|
1036 | FCurrentSection.MinWidth:=i;
|
---|
1037 |
|
---|
1038 | VAL(FMaxWidth.Text,i,c);
|
---|
1039 | IF c<>0 THEN i:=10000;
|
---|
1040 | FCurrentSection.MaxWidth:=i;
|
---|
1041 |
|
---|
1042 | IF FStyle.Text='OwnerDraw' THEN FCurrentSection.Style:=hsOwnerDraw
|
---|
1043 | ELSE FCurrentSection.Style:=hsText;
|
---|
1044 |
|
---|
1045 | IF FAlignment.Text='Center' THEN FCurrentSection.Alignment:=taCenter
|
---|
1046 | ELSE IF FAlignment.Text='Right justify' THEN FCurrentSection.Alignment:=taRightJustify
|
---|
1047 | ELSE FCurrentSection.Alignment:=taLeftJustify;
|
---|
1048 |
|
---|
1049 | FCurrentSection.AllowClick:=FAllowClick.Checked;
|
---|
1050 | FCurrentSection.AllowSize:=FAllowSize.Checked;
|
---|
1051 | END;
|
---|
1052 | END;
|
---|
1053 |
|
---|
1054 | PROCEDURE TCustomHeaderSectionsPropEditDialog.ListItemFocus(Sender:TObject;Index:LONGINT);
|
---|
1055 | BEGIN
|
---|
1056 | StoreItem;
|
---|
1057 |
|
---|
1058 | FCurrentSection:=FSections[Index];
|
---|
1059 | FCurrentIndex:=Index;
|
---|
1060 | FText.Text:=FCurrentSection.Text;
|
---|
1061 | FWidth.Text:=tostr(FCurrentSection.Width);
|
---|
1062 | FMinWidth.Text:=tostr(FCurrentSection.MinWidth);
|
---|
1063 | FMaxWidth.Text:=tostr(FCurrentSection.MaxWidth);
|
---|
1064 | IF FCurrentSection.Style=hsText THEN FStyle.Text:='Text'
|
---|
1065 | ELSE FStyle.Text:='OwnerDraw';
|
---|
1066 |
|
---|
1067 | CASE FCurrentSection.Alignment OF
|
---|
1068 | taRightJustify:FAlignment.Text:='Right justify';
|
---|
1069 | taCenter:FAlignment.Text:='Center';
|
---|
1070 | ELSE FAlignment.Text:='Left justify';
|
---|
1071 | END;
|
---|
1072 |
|
---|
1073 | FAllowClick.Checked:=FCurrentSection.AllowClick;
|
---|
1074 | FAllowSize.Checked:=FCurrentSection.AllowSize;
|
---|
1075 | END;
|
---|
1076 |
|
---|
1077 | PROCEDURE TCustomHeaderSectionsPropEditDialog.SetupComponent;
|
---|
1078 | VAR Button:TButton;
|
---|
1079 | BEGIN
|
---|
1080 | Inherited SetupComponent;
|
---|
1081 |
|
---|
1082 | Caption:='Header sections';
|
---|
1083 | Width:=435;
|
---|
1084 | Height:=350;
|
---|
1085 |
|
---|
1086 | InsertGroupBox(SELF,10,50,180,260,'Sections');
|
---|
1087 | FListBox:=InsertListBox(SELF,20,100,160,190,'');
|
---|
1088 | FListBox.OnItemFocus:=ListItemFocus;
|
---|
1089 |
|
---|
1090 | Button:=InsertButton(SELF,20,60,70,30,'New','Create a new section' );
|
---|
1091 | Button.OnClick:=NewClicked;
|
---|
1092 | Button:=InsertButton(SELF,100,60,70,30,'Delete', 'Delete section' );
|
---|
1093 | Button.OnClick:=DeleteClicked;
|
---|
1094 |
|
---|
1095 | InsertGroupBox(SELF,200,50,220,260,'Section properties' );
|
---|
1096 |
|
---|
1097 | InsertLabel(SELF,210,260,50,20,'Text');
|
---|
1098 | FText:=InsertEdit(SELF,280,265,130,20,'','');
|
---|
1099 | FText.OnChange:=TextChange;
|
---|
1100 |
|
---|
1101 | InsertLabel(SELF,210,230,100,20,'Width');
|
---|
1102 | FWidth:=InsertEdit(SELF,280,235,130,20,'','');
|
---|
1103 | FWidth.OnChange:=WidthChange;
|
---|
1104 | FWidth.NumbersOnly:=TRUE;
|
---|
1105 |
|
---|
1106 | InsertLabel(SELF,210,200,60,20,'Min/max');
|
---|
1107 | FMinWidth:=InsertEdit(SELF,280,205,60,20,'','');
|
---|
1108 | FMinWidth.OnChange:=MinWidthChange;
|
---|
1109 | FMinWidth.NumbersOnly:=TRUE;
|
---|
1110 | FMaxWidth:=InsertEdit(SELF,350,205,60,20,'','');
|
---|
1111 | FMaxWidth.OnChange:=MaxWidthChange;
|
---|
1112 | FMaxWidth.NumbersOnly:=TRUE;
|
---|
1113 |
|
---|
1114 | InsertLabel(SELF,210,170,100,20,'Style');
|
---|
1115 | FStyle:=InsertComboBox(SELF,280,175,130,20,csDropDownList);
|
---|
1116 | FStyle.Items.Add('Text');
|
---|
1117 | FStyle.Items.Add('OwnerDraw');
|
---|
1118 | FStyle.OnItemSelect:=StyleSelect;
|
---|
1119 |
|
---|
1120 | InsertLabel(SELF,210,140,100,20,'Alignment');
|
---|
1121 | FAlignment:=InsertComboBox(SELF,280,145,130,20,csDropDownList);
|
---|
1122 | FAlignment.Items.Add('Left justify');
|
---|
1123 | FAlignment.Items.Add('Right justify');
|
---|
1124 | FAlignment.Items.Add('Center');
|
---|
1125 | FAlignment.OnItemSelect:=AlignmentSelect;
|
---|
1126 |
|
---|
1127 | FAllowClick:=InsertCheckBox(SELF,210,115,180,20,'Allow click','');
|
---|
1128 | FAllowSize:=InsertCheckBox(SELF,210,95,180,20,'Allow size','');
|
---|
1129 |
|
---|
1130 | Button:=InsertButton(SELF,210,60,170,30,'Update','Update the section' );
|
---|
1131 | Button.OnClick:=UpdateClicked;
|
---|
1132 |
|
---|
1133 | InsertBitBtn(SELF,10,10,90,30,bkOk,'OK','');
|
---|
1134 | InsertBitBtn(SELF,110,10,90,30,bkCancel,'Cancel','');
|
---|
1135 | InsertBitBtn(SELF,210,10,90,30,bkHelp,'Help','');
|
---|
1136 | END;
|
---|
1137 |
|
---|
1138 | FUNCTION TCustomHeaderSectionsPropertyEditor.Execute(VAR ClassToEdit:TObject):TClassPropertyEditorReturn;
|
---|
1139 | VAR HeaderSections:TCustomHeaderSections;
|
---|
1140 | FDialog:TCustomHeaderSectionsPropEditDialog;
|
---|
1141 | SaveHeaders:TCustomHeaderSections;
|
---|
1142 | Section:TCustomHeaderSection;
|
---|
1143 | t:LONGINT;
|
---|
1144 | BEGIN
|
---|
1145 | HeaderSections:=TCustomHeaderSections(ClassToEdit);
|
---|
1146 | IF HeaderSections.HeaderControl=NIL THEN
|
---|
1147 | BEGIN
|
---|
1148 | result:=peNoEditor;
|
---|
1149 | exit;
|
---|
1150 | END;
|
---|
1151 |
|
---|
1152 | SaveHeaders.Create(NIL);
|
---|
1153 | SaveHeaders.Assign(HeaderSections);
|
---|
1154 |
|
---|
1155 | FDialog.Create(NIL);
|
---|
1156 | // FDialog.HelpContext := hctxDialogHeaderSectionsPropertyEditor;
|
---|
1157 | FDialog.FSections:=HeaderSections;
|
---|
1158 |
|
---|
1159 | FOR t:=0 TO HeaderSections.Count-1 DO
|
---|
1160 | BEGIN
|
---|
1161 | Section:=HeaderSections[t];
|
---|
1162 | IF Section.Text='' THEN FDialog.FListBox.Items.Add(tostr(t)+' - (Untitled)')
|
---|
1163 | ELSE FDialog.FListBox.Items.Add(tostr(t)+' - '+Section.Text);
|
---|
1164 | END;
|
---|
1165 | IF FDialog.FListBox.Items.Count>0 THEN FDialog.FListBox.ItemIndex:=0;
|
---|
1166 |
|
---|
1167 | FDialog.ShowModal;
|
---|
1168 |
|
---|
1169 | //Modify ClassToEdit here
|
---|
1170 | result:=peCancel;
|
---|
1171 | CASE FDialog.ModalResult OF
|
---|
1172 | cmOk:
|
---|
1173 | BEGIN
|
---|
1174 | FDialog.StoreItem;
|
---|
1175 | result:=peOk;
|
---|
1176 | END;
|
---|
1177 | ELSE
|
---|
1178 | BEGIN
|
---|
1179 | HeaderSections.Assign(SaveHeaders);
|
---|
1180 | result:=peCancel;
|
---|
1181 | END;
|
---|
1182 | END; {case}
|
---|
1183 |
|
---|
1184 | SaveHeaders.Destroy;
|
---|
1185 | FDialog.Destroy;
|
---|
1186 | END;
|
---|
1187 |
|
---|
1188 | Begin
|
---|
1189 | RegisterClasses( [TCustomHeaderControl] );
|
---|
1190 | AddClassPropertyEditor( TCustomHeaderSections, TCustomHeaderSectionsPropertyEditor );
|
---|
1191 | End.
|
---|
1192 |
|
---|
1193 |
|
---|
1194 |
|
---|