[15] | 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 |
|
---|