| 1 |
|
|---|
| 2 | {ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
|---|
| 3 | º º
|
|---|
| 4 | º Sibyl Portable Component Classes º
|
|---|
| 5 | º º
|
|---|
| 6 | º Copyright (C) 1995,97 SpeedSoft Germany, All rights reserved. º
|
|---|
| 7 | º º
|
|---|
| 8 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
|
|---|
| 9 |
|
|---|
| 10 | Unit EXTCTRLS;
|
|---|
| 11 |
|
|---|
| 12 |
|
|---|
| 13 | Interface
|
|---|
| 14 |
|
|---|
| 15 | Uses SysUtils,Classes,Forms,Graphics,Buttons,StdCtrls;
|
|---|
| 16 |
|
|---|
| 17 |
|
|---|
| 18 | Type
|
|---|
| 19 | TShapeType=(stRectangle,stSquare,stRoundRect,stRoundSquare,
|
|---|
| 20 | stEllipse,stCircle,stTriangle);
|
|---|
| 21 |
|
|---|
| 22 | TShape=Class(TControl)
|
|---|
| 23 | Private
|
|---|
| 24 | FTempPen:TPen;
|
|---|
| 25 | FTempBrush:TBrush;
|
|---|
| 26 | FShape:TShapeType;
|
|---|
| 27 | Function GetBrush:TBrush;
|
|---|
| 28 | Function GetPen:TPen;
|
|---|
| 29 | Procedure SetShape(NewShape:TShapeType);
|
|---|
| 30 | Protected
|
|---|
| 31 | Procedure SetupComponent;Override;
|
|---|
| 32 | Procedure SetupShow;Override;
|
|---|
| 33 | Property Canvas;
|
|---|
| 34 | Public
|
|---|
| 35 | Destructor Destroy;Override;
|
|---|
| 36 | Procedure Redraw(Const rec:TRect);Override;
|
|---|
| 37 | Property XAlign;
|
|---|
| 38 | Property XStretch;
|
|---|
| 39 | Property YAlign;
|
|---|
| 40 | Property YStretch;
|
|---|
| 41 | Published
|
|---|
| 42 | Property Align;
|
|---|
| 43 | Property Brush:TBrush Read GetBrush;
|
|---|
| 44 | Property DragCursor;
|
|---|
| 45 | Property DragMode;
|
|---|
| 46 | Property Enabled;
|
|---|
| 47 | Property ParentShowHint;
|
|---|
| 48 | Property Pen:TPen Read GetPen;
|
|---|
| 49 | Property Shape:TShapeType Read FShape Write SetShape;
|
|---|
| 50 | Property ShowHint;
|
|---|
| 51 | Property Visible;
|
|---|
| 52 | Property ZOrder;
|
|---|
| 53 |
|
|---|
| 54 | Property OnCanDrag;
|
|---|
| 55 | Property OnDragDrop;
|
|---|
| 56 | Property OnDragOver;
|
|---|
| 57 | Property OnEndDrag;
|
|---|
| 58 | Property OnMouseClick;
|
|---|
| 59 | Property OnMouseDblClick;
|
|---|
| 60 | Property OnMouseDown;
|
|---|
| 61 | Property OnMouseMove;
|
|---|
| 62 | Property OnMouseUp;
|
|---|
| 63 | Property OnSetupShow;
|
|---|
| 64 | Property OnStartDrag;
|
|---|
| 65 | End;
|
|---|
| 66 |
|
|---|
| 67 |
|
|---|
| 68 | TPaintBox=Class(TControl)
|
|---|
| 69 | Protected
|
|---|
| 70 | Procedure SetupComponent;Override;
|
|---|
| 71 | Public
|
|---|
| 72 | Procedure Redraw(Const rec:TRect);Override;
|
|---|
| 73 | Property XAlign;
|
|---|
| 74 | Property XStretch;
|
|---|
| 75 | Property YAlign;
|
|---|
| 76 | Property YStretch;
|
|---|
| 77 | Published
|
|---|
| 78 | Property Align;
|
|---|
| 79 | Property Color;
|
|---|
| 80 | Property DragCursor;
|
|---|
| 81 | Property DragMode;
|
|---|
| 82 | Property Enabled;
|
|---|
| 83 | Property Font;
|
|---|
| 84 | Property ParentColor;
|
|---|
| 85 | Property ParentPenColor;
|
|---|
| 86 | Property ParentFont;
|
|---|
| 87 | Property ParentShowHint;
|
|---|
| 88 | Property PenColor;
|
|---|
| 89 | Property ShowHint;
|
|---|
| 90 | Property Visible;
|
|---|
| 91 | Property ZOrder;
|
|---|
| 92 |
|
|---|
| 93 | Property OnCanDrag;
|
|---|
| 94 | Property OnClick;
|
|---|
| 95 | Property OnDblClick;
|
|---|
| 96 | Property OnDragDrop;
|
|---|
| 97 | Property OnDragOver;
|
|---|
| 98 | Property OnEndDrag;
|
|---|
| 99 | Property OnFontChange;
|
|---|
| 100 | Property OnMouseClick;
|
|---|
| 101 | Property OnMouseDblClick;
|
|---|
| 102 | Property OnMouseDown;
|
|---|
| 103 | Property OnMouseMove;
|
|---|
| 104 | Property OnMouseUp;
|
|---|
| 105 | Property OnPaint;
|
|---|
| 106 | Property OnSetupShow;
|
|---|
| 107 | Property OnStartDrag;
|
|---|
| 108 | End;
|
|---|
| 109 |
|
|---|
| 110 |
|
|---|
| 111 | TImage=Class(TControl)
|
|---|
| 112 | Private
|
|---|
| 113 | FPicture:TPicture;
|
|---|
| 114 | FNeedBitmap:Boolean;
|
|---|
| 115 | FAutoSize:Boolean;
|
|---|
| 116 | FStretch:Boolean;
|
|---|
| 117 | FCenter:Boolean;
|
|---|
| 118 | FOnChange:TNotifyEvent;
|
|---|
| 119 | Procedure SetStretch(NewValue:Boolean);
|
|---|
| 120 | Procedure SetCenter(NewValue:Boolean);
|
|---|
| 121 | Procedure SetBitmap(NewBitmap:TBitmap);
|
|---|
| 122 | Function GetBitmap:TBitmap;
|
|---|
| 123 | Function GetIcon:TIcon;
|
|---|
| 124 | Procedure SetIcon(NewIcon:TIcon);
|
|---|
| 125 | Function GetGraphic:TGraphic;
|
|---|
| 126 | Procedure SetGraphic(NewGraphic:TGraphic);
|
|---|
| 127 | Procedure PictureChanged(Sender:TObject);
|
|---|
| 128 | Protected
|
|---|
| 129 | Procedure Change;Virtual;
|
|---|
| 130 | Procedure SetupComponent;Override;
|
|---|
| 131 | Procedure SetupShow;Override;
|
|---|
| 132 | Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
|
|---|
| 133 | Property NeedBitmap:Boolean Read FNeedBitmap Write FNeedBitmap;
|
|---|
| 134 | Public
|
|---|
| 135 | Destructor Destroy;Override;
|
|---|
| 136 | Procedure Redraw(Const rec:TRect);Override;
|
|---|
| 137 | Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
|
|---|
| 138 | Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
|
|---|
| 139 | Public
|
|---|
| 140 | Property XAlign;
|
|---|
| 141 | Property XStretch;
|
|---|
| 142 | Property YAlign;
|
|---|
| 143 | Property YStretch;
|
|---|
| 144 | Property Picture:TPicture Read {Get}FPicture;
|
|---|
| 145 | Property Graphic:TGraphic read GetGraphic write SetGraphic;
|
|---|
| 146 | Property Icon:TIcon Read GetIcon Write SetIcon;
|
|---|
| 147 | Published
|
|---|
| 148 | Property Align;
|
|---|
| 149 | Property AutoSize:Boolean Read FAutoSize Write FAutoSize;
|
|---|
| 150 | Property Center:Boolean Read FCenter Write SetCenter;
|
|---|
| 151 | Property DragCursor;
|
|---|
| 152 | Property DragMode;
|
|---|
| 153 | Property Enabled;
|
|---|
| 154 | Property ParentShowHint;
|
|---|
| 155 | Property Bitmap:TBitmap Read GetBitmap Write SetBitmap;
|
|---|
| 156 | Property PopupMenu;
|
|---|
| 157 | Property ShowHint;
|
|---|
| 158 | Property Stretch:Boolean Read FStretch Write SetStretch;
|
|---|
| 159 | Property Visible;
|
|---|
| 160 | Property ZOrder;
|
|---|
| 161 |
|
|---|
| 162 | Property OnCanDrag;
|
|---|
| 163 | Property OnChange:TNotifyEvent read FOnChange write FOnChange;
|
|---|
| 164 | Property OnClick;
|
|---|
| 165 | Property OnDblClick;
|
|---|
| 166 | Property OnDragDrop;
|
|---|
| 167 | Property OnDragOver;
|
|---|
| 168 | Property OnEndDrag;
|
|---|
| 169 | Property OnMouseClick;
|
|---|
| 170 | Property OnMouseDblClick;
|
|---|
| 171 | Property OnMouseDown;
|
|---|
| 172 | Property OnMouseMove;
|
|---|
| 173 | Property OnMouseUp;
|
|---|
| 174 | Property OnSetupShow;
|
|---|
| 175 | Property OnStartDrag;
|
|---|
| 176 | End;
|
|---|
| 177 |
|
|---|
| 178 |
|
|---|
| 179 | {$M+}
|
|---|
| 180 | TBevelShape=(bsBottomLine,bsBox,bsFrame,bsLeftLine,bsRightLine,bsTopLine,
|
|---|
| 181 | bsBorder);
|
|---|
| 182 |
|
|---|
| 183 | TBevelStyle=(bsLowered,bsRaised);
|
|---|
| 184 | {$M-}
|
|---|
| 185 |
|
|---|
| 186 | TBevel=Class(TControl)
|
|---|
| 187 | Private
|
|---|
| 188 | FShape:TBevelShape;
|
|---|
| 189 | FStyle:TBevelStyle;
|
|---|
| 190 | Procedure SetShape(NewShape:TBevelShape);
|
|---|
| 191 | Procedure SetStyle(NewStyle:TBevelStyle);
|
|---|
| 192 | Protected
|
|---|
| 193 | Procedure SetupComponent;Override;
|
|---|
| 194 | Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
|
|---|
| 195 | Public
|
|---|
| 196 | Procedure Redraw(Const rec:TRect);Override;
|
|---|
| 197 | Property XAlign;
|
|---|
| 198 | Property XStretch;
|
|---|
| 199 | Property YAlign;
|
|---|
| 200 | Property YStretch;
|
|---|
| 201 | Published
|
|---|
| 202 | Property Align;
|
|---|
| 203 | Property ParentShowHint;
|
|---|
| 204 | Property PopupMenu;
|
|---|
| 205 | Property Shape:TBevelShape Read FShape Write SetShape;
|
|---|
| 206 | Property ShowHint;
|
|---|
| 207 | Property Style:TBevelStyle Read FStyle Write SetStyle;
|
|---|
| 208 | Property Visible;
|
|---|
| 209 | Property ZOrder;
|
|---|
| 210 |
|
|---|
| 211 | Property OnCommand;
|
|---|
| 212 | Property OnResize;
|
|---|
| 213 | Property OnSetupShow;
|
|---|
| 214 | End;
|
|---|
| 215 |
|
|---|
| 216 |
|
|---|
| 217 | {$M+}
|
|---|
| 218 | TPanelBevel=(bvRaised,bvLowered,bvNone);
|
|---|
| 219 | {$M-}
|
|---|
| 220 |
|
|---|
| 221 | TPanel=Class(TControl)
|
|---|
| 222 | Private
|
|---|
| 223 | FBevelInner:TPanelBevel;
|
|---|
| 224 | FBevelOuter:TPanelBevel;
|
|---|
| 225 | FBevelWidth:LongInt;
|
|---|
| 226 | FBorderStyle:TBorderStyle;
|
|---|
| 227 | FBorderWidth:LongInt;
|
|---|
| 228 | FAlignment:TAlignment;
|
|---|
| 229 | FInterior:TRect;
|
|---|
| 230 | Procedure CMTextChanged(Var Msg:TMessage); Message CM_TEXTCHANGED;
|
|---|
| 231 | Procedure SetBevelInner(NewBevel:TPanelBevel);
|
|---|
| 232 | Procedure SetBevelOuter(NewBevel:TPanelBevel);
|
|---|
| 233 | Procedure SetBevelWidth(NewWidth:LongInt);
|
|---|
| 234 | Procedure SetBorderStyle(NewStyle:TBorderStyle);
|
|---|
| 235 | Procedure SetBorderWidth(NewWidth:LongInt);
|
|---|
| 236 | Procedure SetAlignment(ta:TAlignment);
|
|---|
| 237 | Protected
|
|---|
| 238 | Procedure SetupComponent;Override;
|
|---|
| 239 | Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
|
|---|
| 240 | Procedure DrawText(Const rec:TRect);Virtual;
|
|---|
| 241 | Public
|
|---|
| 242 | Procedure Redraw(Const rec:TRect);Override;
|
|---|
| 243 | Property XAlign;
|
|---|
| 244 | Property XStretch;
|
|---|
| 245 | Property YAlign;
|
|---|
| 246 | Property YStretch;
|
|---|
| 247 | Published
|
|---|
| 248 | Property Align;
|
|---|
| 249 | Property Alignment:TAlignment Read FAlignment Write SetAlignment;
|
|---|
| 250 | Property BevelInner:TPanelBevel Read FBevelInner Write SetBevelInner;
|
|---|
| 251 | Property BevelOuter:TPanelBevel Read FBevelOuter Write SetBevelOuter;
|
|---|
| 252 | Property BevelWidth:LongInt Read FBevelWidth Write SetBevelWidth;
|
|---|
| 253 | Property BorderStyle:TBorderStyle Read FBorderStyle Write SetBorderStyle;
|
|---|
| 254 | Property BorderWidth:LongInt Read FBorderWidth Write SetBorderWidth;
|
|---|
| 255 | Property Caption;
|
|---|
| 256 | Property Color;
|
|---|
| 257 | Property DragCursor;
|
|---|
| 258 | Property DragMode;
|
|---|
| 259 | Property Enabled;
|
|---|
| 260 | Property Font;
|
|---|
| 261 | Property ParentColor;
|
|---|
| 262 | Property ParentPenColor;
|
|---|
| 263 | Property ParentFont;
|
|---|
| 264 | Property ParentShowHint;
|
|---|
| 265 | Property PenColor;
|
|---|
| 266 | Property PopupMenu;
|
|---|
| 267 | Property ShowHint;
|
|---|
| 268 | Property TabOrder;
|
|---|
| 269 | Property TabStop;
|
|---|
| 270 | Property Visible;
|
|---|
| 271 | Property ZOrder;
|
|---|
| 272 |
|
|---|
| 273 | Property OnCanDrag;
|
|---|
| 274 | Property OnClick;
|
|---|
| 275 | Property OnCommand;
|
|---|
| 276 | Property OnDblClick;
|
|---|
| 277 | Property OnDragDrop;
|
|---|
| 278 | Property OnDragOver;
|
|---|
| 279 | Property OnEndDrag;
|
|---|
| 280 | Property OnFontChange;
|
|---|
| 281 | Property OnMouseClick;
|
|---|
| 282 | Property OnMouseDblClick;
|
|---|
| 283 | Property OnMouseDown;
|
|---|
| 284 | Property OnMouseMove;
|
|---|
| 285 | Property OnMouseUp;
|
|---|
| 286 | Property OnPaint;
|
|---|
| 287 | Property OnResize;
|
|---|
| 288 | Property OnSetupShow;
|
|---|
| 289 | Property OnStartDrag;
|
|---|
| 290 | End;
|
|---|
| 291 |
|
|---|
| 292 |
|
|---|
| 293 | TRadioGroup=Class(TGroupBox)
|
|---|
| 294 | Private
|
|---|
| 295 | FItems:TStrings;
|
|---|
| 296 | FRadios:TList;
|
|---|
| 297 | FItemIndex:LongInt;
|
|---|
| 298 | FColumns:LongInt;
|
|---|
| 299 | FOnClick:TNotifyEvent;
|
|---|
| 300 | FIsTabStop:boolean; // radio buttons are tabstops
|
|---|
| 301 | Procedure SetItemIndex(Value:LongInt);
|
|---|
| 302 | Procedure SetColumns(Value:LongInt);
|
|---|
| 303 | Procedure SetItems(Value:TStrings);
|
|---|
| 304 | Procedure SetRadioCount(Value:LongInt);
|
|---|
| 305 | Function GetItemsEnabled(Index:LongInt):Boolean;
|
|---|
| 306 | Procedure SetItemsEnabled(Index:LongInt;Value:Boolean);
|
|---|
| 307 | Procedure UpdateRadios;
|
|---|
| 308 | Procedure ArrangeRadios;
|
|---|
| 309 | Procedure EvItemsChange(Sender:TObject);
|
|---|
| 310 | Procedure EvRadioClick(Sender:TObject);
|
|---|
| 311 | procedure UpdateTabList;
|
|---|
| 312 | Protected
|
|---|
| 313 | Procedure SetupComponent;Override;
|
|---|
| 314 | Procedure SetupShow;Override;
|
|---|
| 315 | Procedure Resize;Override;
|
|---|
| 316 | Procedure FontChange;Override;
|
|---|
| 317 | Procedure Click;Virtual;
|
|---|
| 318 | Procedure ItemIndexChange;Virtual;
|
|---|
| 319 | function GetTabStop:boolean;
|
|---|
| 320 | procedure SetTabStop(Value:boolean);
|
|---|
| 321 | procedure WMFocussing( Var Msg: TMessage ); message WM_FOCUSSING;
|
|---|
| 322 | Public
|
|---|
| 323 | Destructor Destroy;Override;
|
|---|
| 324 | Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
|
|---|
| 325 | Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
|
|---|
| 326 | Property ItemsEnabled[Index:LongInt]:Boolean Read GetItemsEnabled Write SetItemsEnabled;
|
|---|
| 327 | Property XAlign;
|
|---|
| 328 | Property XStretch;
|
|---|
| 329 | Property YAlign;
|
|---|
| 330 | Property YStretch;
|
|---|
| 331 | Published
|
|---|
| 332 | Property Align;
|
|---|
| 333 | Property Caption;
|
|---|
| 334 | Property Color;
|
|---|
| 335 | Property Columns:LongInt Read FColumns Write SetColumns;
|
|---|
| 336 | Property DragCursor;
|
|---|
| 337 | Property DragMode;
|
|---|
| 338 | Property Enabled;
|
|---|
| 339 | Property Font;
|
|---|
| 340 | Property ItemIndex:LongInt Read FItemIndex Write SetItemIndex;
|
|---|
| 341 | Property Items:TStrings Read FItems Write SetItems;
|
|---|
| 342 | Property ParentColor;
|
|---|
| 343 | Property ParentPenColor;
|
|---|
| 344 | Property ParentFont;
|
|---|
| 345 | Property ParentShowHint;
|
|---|
| 346 | Property PenColor;
|
|---|
| 347 | Property ShowHint;
|
|---|
| 348 | Property TabOrder;
|
|---|
| 349 | property TabStop: boolean read GetTabStop write SetTabStop;
|
|---|
| 350 | Property Visible;
|
|---|
| 351 | Property ZOrder;
|
|---|
| 352 |
|
|---|
| 353 | Property OnCanDrag;
|
|---|
| 354 | Property OnClick:TNotifyEvent Read FOnClick Write FOnClick;
|
|---|
| 355 | Property OnDragDrop;
|
|---|
| 356 | Property OnDragOver;
|
|---|
| 357 | Property OnEndDrag;
|
|---|
| 358 | Property OnEnter;
|
|---|
| 359 | Property OnExit;
|
|---|
| 360 | Property OnFontChange;
|
|---|
| 361 | Property OnSetupShow;
|
|---|
| 362 | Property OnStartDrag;
|
|---|
| 363 | End;
|
|---|
| 364 |
|
|---|
| 365 |
|
|---|
| 366 |
|
|---|
| 367 | Function InsertShape(parent:TControl;Left,Bottom,Width,Height:LongInt):TShape;
|
|---|
| 368 | Function InsertImage(parent:TControl;Left,Bottom,Width,Height:LongInt;BitmapId:LongWord):TImage;
|
|---|
| 369 | Function InsertImageName(parent:TControl;Left,Bottom,Width,Height:LongInt;Const BitmapId:String):TImage;
|
|---|
| 370 | Function InsertBevel(parent:TControl;Left,Bottom,Width,Height:LongInt;
|
|---|
| 371 | Shape:TBevelShape;Style:TBevelStyle):TBevel;
|
|---|
| 372 | Function InsertPanel(parent:TControl;Left,Bottom,Width,Height:LongInt;
|
|---|
| 373 | BevelInner:TPanelBevel;BevelOuter:TPanelBevel;BevelWidth:LongInt;
|
|---|
| 374 | Caption:String):TPanel;
|
|---|
| 375 | Function InsertRadioGroup(parent:TControl;Left,Bottom,Width,Height:LongInt;
|
|---|
| 376 | Caption:String):TRadioGroup;
|
|---|
| 377 |
|
|---|
| 378 |
|
|---|
| 379 | Implementation
|
|---|
| 380 |
|
|---|
| 381 |
|
|---|
| 382 | Function InsertShape(parent:TControl;Left,Bottom,Width,Height:LongInt):TShape;
|
|---|
| 383 | Begin
|
|---|
| 384 | Result.Create(parent);
|
|---|
| 385 | Result.SetWindowPos(Left,Bottom,Width,Height);
|
|---|
| 386 | Result.parent := parent;
|
|---|
| 387 | End;
|
|---|
| 388 |
|
|---|
| 389 |
|
|---|
| 390 | Function InsertImage(Parent:TControl;Left,Bottom,Width,Height:LongInt;
|
|---|
| 391 | BitmapId:LongWord):TImage;
|
|---|
| 392 | Var Bitmap:TBitmap;
|
|---|
| 393 | Begin
|
|---|
| 394 | Result.Create(parent);
|
|---|
| 395 | Result.SetWindowPos(Left,Bottom,Width,Height);
|
|---|
| 396 | Bitmap.Create;
|
|---|
| 397 | Bitmap.LoadFromResourceId(BitmapId);
|
|---|
| 398 | Result.Picture.Graphic:=Bitmap;
|
|---|
| 399 | Bitmap.Destroy; {#}
|
|---|
| 400 | Result.Parent := Parent;
|
|---|
| 401 | End;
|
|---|
| 402 |
|
|---|
| 403 | Function InsertImageName(Parent:TControl;Left,Bottom,Width,Height:LongInt;
|
|---|
| 404 | Const BitmapId:String):TImage;
|
|---|
| 405 | Var Bitmap:TBitmap;
|
|---|
| 406 | Begin
|
|---|
| 407 | Result.Create(parent);
|
|---|
| 408 | Result.SetWindowPos(Left,Bottom,Width,Height);
|
|---|
| 409 | Bitmap.Create;
|
|---|
| 410 | Bitmap.LoadFromResourceName(BitmapId);
|
|---|
| 411 | Result.Picture.Graphic:=Bitmap;
|
|---|
| 412 | Bitmap.Destroy; {#}
|
|---|
| 413 | Result.Parent := Parent;
|
|---|
| 414 | End;
|
|---|
| 415 |
|
|---|
| 416 |
|
|---|
| 417 | Function InsertBevel(parent:TControl;Left,Bottom,Width,Height:LongInt;
|
|---|
| 418 | Shape:TBevelShape;Style:TBevelStyle):TBevel;
|
|---|
| 419 | Begin
|
|---|
| 420 | Result.Create(parent);
|
|---|
| 421 | Result.Shape := Shape;
|
|---|
| 422 | Result.Style := Style;
|
|---|
| 423 | Result.SetWindowPos(Left,Bottom,Width,Height);
|
|---|
| 424 | Result.parent := parent;
|
|---|
| 425 | End;
|
|---|
| 426 |
|
|---|
| 427 |
|
|---|
| 428 | Function InsertPanel(parent:TControl;Left,Bottom,Width,Height:LongInt;
|
|---|
| 429 | BevelInner:TPanelBevel;BevelOuter:TPanelBevel;BevelWidth:LongInt;
|
|---|
| 430 | Caption:String):TPanel;
|
|---|
| 431 | Begin
|
|---|
| 432 | Result.Create(parent);
|
|---|
| 433 | Result.BevelInner:=BevelInner;
|
|---|
| 434 | Result.BevelOuter:=BevelOuter;
|
|---|
| 435 | Result.BevelWidth:=BevelWidth;
|
|---|
| 436 | Result.SetWindowPos(Left,Bottom,Width,Height);
|
|---|
| 437 | Result.Caption := Caption;
|
|---|
| 438 | Result.parent := parent;
|
|---|
| 439 | End;
|
|---|
| 440 |
|
|---|
| 441 |
|
|---|
| 442 | Function InsertRadioGroup(parent:TControl;Left,Bottom,Width,Height:LongInt;
|
|---|
| 443 | Caption:String):TRadioGroup;
|
|---|
| 444 | Begin
|
|---|
| 445 | Result.Create(parent);
|
|---|
| 446 | Result.SetWindowPos(Left,Bottom,Width,Height);
|
|---|
| 447 | Result.Caption := Caption;
|
|---|
| 448 | Result.parent := parent;
|
|---|
| 449 | End;
|
|---|
| 450 |
|
|---|
| 451 |
|
|---|
| 452 |
|
|---|
| 453 | {
|
|---|
| 454 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
|---|
| 455 | º º
|
|---|
| 456 | º Speed-Pascal/2 Version 2.0 º
|
|---|
| 457 | º º
|
|---|
| 458 | º Speed-Pascal Component Classes (SPCC) º
|
|---|
| 459 | º º
|
|---|
| 460 | º This section: TShape Class Implementation º
|
|---|
| 461 | º º
|
|---|
| 462 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
|---|
| 463 | º º
|
|---|
| 464 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
|---|
| 465 | }
|
|---|
| 466 |
|
|---|
| 467 | Procedure TShape.SetupComponent;
|
|---|
| 468 | Begin
|
|---|
| 469 | Inherited SetupComponent;
|
|---|
| 470 |
|
|---|
| 471 | Name:='Shape';
|
|---|
| 472 | Height:=100;
|
|---|
| 473 | Width:=100;
|
|---|
| 474 | ParentPenColor:=False;
|
|---|
| 475 | ParentColor:=True;
|
|---|
| 476 | TabStop:=False;
|
|---|
| 477 | ZOrder:=zoBottom;
|
|---|
| 478 | FShape:=stRectangle;
|
|---|
| 479 | FTempBrush.Create(Nil);
|
|---|
| 480 | //FTempBrush.Color := clWhite;
|
|---|
| 481 | FTempPen.Create(Nil);
|
|---|
| 482 | End;
|
|---|
| 483 |
|
|---|
| 484 | Procedure TShape.SetupShow;
|
|---|
| 485 | Begin
|
|---|
| 486 | Inherited SetupShow;
|
|---|
| 487 |
|
|---|
| 488 | Canvas.Brush:=FTempBrush;
|
|---|
| 489 | Canvas.Pen:=FTempPen;
|
|---|
| 490 | End;
|
|---|
| 491 |
|
|---|
| 492 | Destructor TShape.Destroy;
|
|---|
| 493 | Begin
|
|---|
| 494 | Inherited Destroy;
|
|---|
| 495 |
|
|---|
| 496 | FTempBrush.Destroy;
|
|---|
| 497 | FTempPen.Destroy;
|
|---|
| 498 | End;
|
|---|
| 499 |
|
|---|
| 500 | Function TShape.GetBrush:TBrush;
|
|---|
| 501 | Begin
|
|---|
| 502 | If Canvas <> Nil Then Result := Canvas.Brush
|
|---|
| 503 | Else Result := FTempBrush;
|
|---|
| 504 | End;
|
|---|
| 505 |
|
|---|
| 506 | Function TShape.GetPen:TPen;
|
|---|
| 507 | Begin
|
|---|
| 508 | If Canvas <> Nil Then Result := Canvas.Pen
|
|---|
| 509 | Else Result := FTempPen;
|
|---|
| 510 | End;
|
|---|
| 511 |
|
|---|
| 512 | Procedure TShape.SetShape(NewShape:TShapeType);
|
|---|
| 513 | Begin
|
|---|
| 514 | FShape:=NewShape;
|
|---|
| 515 | Invalidate;
|
|---|
| 516 | End;
|
|---|
| 517 |
|
|---|
| 518 | Procedure TShape.Redraw(Const rec:TRect);
|
|---|
| 519 | Var SaveColor:TColor;
|
|---|
| 520 | OldPenColor,OldBrushColor:TColor;
|
|---|
| 521 | SaveStyle:TBrushStyle;
|
|---|
| 522 | Radius,middleX,MiddleY,W,H:LongInt;
|
|---|
| 523 | rc:TRect;
|
|---|
| 524 |
|
|---|
| 525 | Procedure DrawTriangle;
|
|---|
| 526 | Begin
|
|---|
| 527 | Canvas.PenPos:=Point(0,0);
|
|---|
| 528 | Canvas.LineTo(Width,0);
|
|---|
| 529 | Canvas.LineTo(Width Div 2,Height);
|
|---|
| 530 | Canvas.LineTo(0,0);
|
|---|
| 531 | End;
|
|---|
| 532 | Begin
|
|---|
| 533 | If Canvas = Nil Then exit;
|
|---|
| 534 | OldPenColor := Canvas.Pen.Color;
|
|---|
| 535 | OldBrushColor := Canvas.Brush.Color;
|
|---|
| 536 |
|
|---|
| 537 | SaveColor:=Canvas.Pen.color;
|
|---|
| 538 |
|
|---|
| 539 | If Canvas.Brush.Style=bsSolid Then Canvas.Pen.color:=Canvas.Brush.color;
|
|---|
| 540 |
|
|---|
| 541 | middleX := ClientWidth Div 2;
|
|---|
| 542 | MiddleY := ClientHeight Div 2;
|
|---|
| 543 |
|
|---|
| 544 | Case FShape Of
|
|---|
| 545 | stTriangle:
|
|---|
| 546 | Begin
|
|---|
| 547 | Canvas.BeginPath;
|
|---|
| 548 | DrawTriangle;
|
|---|
| 549 | Canvas.EndPath;
|
|---|
| 550 | Canvas.FillPath;
|
|---|
| 551 | Canvas.Pen.color:=SaveColor;
|
|---|
| 552 |
|
|---|
| 553 | Canvas.BeginPath;
|
|---|
| 554 | DrawTriangle;
|
|---|
| 555 | Canvas.EndPath;
|
|---|
| 556 | Canvas.OutlinePath;
|
|---|
| 557 |
|
|---|
| 558 | Canvas.BeginPath;
|
|---|
| 559 | DrawTriangle;
|
|---|
| 560 | Canvas.EndPath;
|
|---|
| 561 | Canvas.PathToClipRegion(paDiff);
|
|---|
| 562 | End;
|
|---|
| 563 | stRectangle,stSquare:
|
|---|
| 564 | Begin
|
|---|
| 565 | If FShape=stSquare Then
|
|---|
| 566 | Begin
|
|---|
| 567 | If Width>Height Then
|
|---|
| 568 | Begin
|
|---|
| 569 | rc.Bottom:=0;
|
|---|
| 570 | rc.Top:=Height-1;
|
|---|
| 571 | rc.Left:=(Width-Height) Div 2;
|
|---|
| 572 | rc.Right:=rc.Left+Height;
|
|---|
| 573 | End
|
|---|
| 574 | Else
|
|---|
| 575 | Begin
|
|---|
| 576 | rc.Left:=0;
|
|---|
| 577 | rc.Right:=Width-1;
|
|---|
| 578 | rc.Bottom:=(Height-Width) Div 2;
|
|---|
| 579 | rc.Top:=rc.Bottom+Width;
|
|---|
| 580 | End;
|
|---|
| 581 | End
|
|---|
| 582 | Else rc:=ClientRect;
|
|---|
| 583 |
|
|---|
| 584 | Canvas.BeginPath;
|
|---|
| 585 | Canvas.Rectangle(rc);
|
|---|
| 586 | Canvas.EndPath;
|
|---|
| 587 | Canvas.FillPath;
|
|---|
| 588 | Canvas.Pen.color:=SaveColor;
|
|---|
| 589 |
|
|---|
| 590 | Canvas.BeginPath;
|
|---|
| 591 | Canvas.Rectangle(rc);
|
|---|
| 592 | Canvas.EndPath;
|
|---|
| 593 | Canvas.OutlinePath;
|
|---|
| 594 |
|
|---|
| 595 | Canvas.BeginPath;
|
|---|
| 596 | Canvas.Rectangle(rc);
|
|---|
| 597 | Canvas.EndPath;
|
|---|
| 598 | Canvas.PathToClipRegion(paDiff);
|
|---|
| 599 | End;
|
|---|
| 600 | stRoundRect,stRoundSquare:
|
|---|
| 601 | Begin
|
|---|
| 602 | If FShape=stRoundSquare Then
|
|---|
| 603 | Begin
|
|---|
| 604 | If Width>Height Then
|
|---|
| 605 | Begin
|
|---|
| 606 | rc.Bottom:=0;
|
|---|
| 607 | rc.Top:=Height-1;
|
|---|
| 608 | rc.Left:=(Width-Height) Div 2;
|
|---|
| 609 | rc.Right:=rc.Left+Height;
|
|---|
| 610 | End
|
|---|
| 611 | Else
|
|---|
| 612 | Begin
|
|---|
| 613 | rc.Left:=0;
|
|---|
| 614 | rc.Right:=Width-1;
|
|---|
| 615 | rc.Bottom:=(Height-Width) Div 2;
|
|---|
| 616 | rc.Top:=rc.Bottom+Width;
|
|---|
| 617 | End;
|
|---|
| 618 | End
|
|---|
| 619 | Else rc:=ClientRect;
|
|---|
| 620 |
|
|---|
| 621 | W:=(rc.Right-rc.Left) Div 10;
|
|---|
| 622 | H:=(rc.Top-rc.Bottom) Div 10;
|
|---|
| 623 |
|
|---|
| 624 | Canvas.BeginPath;
|
|---|
| 625 | Canvas.RoundRect(rc,W,H);
|
|---|
| 626 | Canvas.EndPath;
|
|---|
| 627 | Canvas.FillPath;
|
|---|
| 628 | Canvas.Pen.color:=SaveColor;
|
|---|
| 629 |
|
|---|
| 630 | Canvas.BeginPath;
|
|---|
| 631 | Canvas.RoundRect(rc,W,H);
|
|---|
| 632 | Canvas.EndPath;
|
|---|
| 633 | Canvas.OutlinePath;
|
|---|
| 634 |
|
|---|
| 635 | Canvas.BeginPath;
|
|---|
| 636 | Canvas.RoundRect(rc,W,H);
|
|---|
| 637 | Canvas.EndPath;
|
|---|
| 638 | Canvas.PathToClipRegion(paDiff);
|
|---|
| 639 | End;
|
|---|
| 640 | stEllipse:
|
|---|
| 641 | Begin
|
|---|
| 642 | Canvas.BeginPath;
|
|---|
| 643 | Canvas.Ellipse(middleX,MiddleY,middleX-1,MiddleY-1);
|
|---|
| 644 | Canvas.EndPath;
|
|---|
| 645 | Canvas.FillPath;
|
|---|
| 646 | Canvas.Pen.color:=SaveColor;
|
|---|
| 647 |
|
|---|
| 648 | Canvas.BeginPath;
|
|---|
| 649 | Canvas.Ellipse(middleX,MiddleY,middleX-1,MiddleY-1);
|
|---|
| 650 | Canvas.EndPath;
|
|---|
| 651 | Canvas.OutlinePath;
|
|---|
| 652 |
|
|---|
| 653 | Canvas.BeginPath;
|
|---|
| 654 | Canvas.Ellipse(middleX,MiddleY,middleX-1,MiddleY-1);
|
|---|
| 655 | Canvas.EndPath;
|
|---|
| 656 | Canvas.PathToClipRegion(paDiff);
|
|---|
| 657 | End;
|
|---|
| 658 | stCircle:
|
|---|
| 659 | Begin
|
|---|
| 660 | If ClientWidth>ClientHeight Then Radius:=MiddleY
|
|---|
| 661 | Else Radius:=middleX;
|
|---|
| 662 |
|
|---|
| 663 | Canvas.BeginPath;
|
|---|
| 664 | Canvas.Circle(middleX,MiddleY,Radius-1);
|
|---|
| 665 | Canvas.EndPath;
|
|---|
| 666 | Canvas.FillPath;
|
|---|
| 667 | Canvas.Pen.color:=SaveColor;
|
|---|
| 668 |
|
|---|
| 669 | Canvas.BeginPath;
|
|---|
| 670 | Canvas.Circle(middleX,MiddleY,Radius-1);
|
|---|
| 671 | Canvas.EndPath;
|
|---|
| 672 | Canvas.OutlinePath;
|
|---|
| 673 |
|
|---|
| 674 | Canvas.BeginPath;
|
|---|
| 675 | Canvas.Circle(middleX,MiddleY,Radius-1);
|
|---|
| 676 | Canvas.EndPath;
|
|---|
| 677 | Canvas.PathToClipRegion(paDiff);
|
|---|
| 678 | End;
|
|---|
| 679 | End; //Case
|
|---|
| 680 |
|
|---|
| 681 | Canvas.Pen.Color := OldPenColor;
|
|---|
| 682 | Canvas.Brush.Color := OldBrushColor;
|
|---|
| 683 |
|
|---|
| 684 | SaveColor:=Canvas.Pen.color;
|
|---|
| 685 | SaveStyle:=Canvas.Brush.Style;
|
|---|
| 686 |
|
|---|
| 687 | Canvas.Pen.color:=color;
|
|---|
| 688 | Canvas.Brush.Style:=bsSolid;
|
|---|
| 689 | Canvas.Box(rec);
|
|---|
| 690 |
|
|---|
| 691 | Canvas.Pen.color:=SaveColor;
|
|---|
| 692 | Canvas.Brush.Style:=SaveStyle;
|
|---|
| 693 | End;
|
|---|
| 694 |
|
|---|
| 695 |
|
|---|
| 696 | {
|
|---|
| 697 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
|---|
| 698 | º º
|
|---|
| 699 | º Speed-Pascal/2 Version 2.0 º
|
|---|
| 700 | º º
|
|---|
| 701 | º Speed-Pascal Component Classes (SPCC) º
|
|---|
| 702 | º º
|
|---|
| 703 | º This section: TImage Class Implementation º
|
|---|
| 704 | º º
|
|---|
| 705 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
|---|
| 706 | º º
|
|---|
| 707 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
|---|
| 708 | }
|
|---|
| 709 |
|
|---|
| 710 |
|
|---|
| 711 | Procedure TImage.SetupComponent;
|
|---|
| 712 | Begin
|
|---|
| 713 | Inherited SetupComponent;
|
|---|
| 714 |
|
|---|
| 715 | Name:='Image';
|
|---|
| 716 | Caption:=Name;
|
|---|
| 717 | Width:=50;
|
|---|
| 718 | Height:=50;
|
|---|
| 719 | ParentPenColor:=False;
|
|---|
| 720 | ParentColor:=True;
|
|---|
| 721 | CursorTabStop:=False;
|
|---|
| 722 | TabStop:=False;
|
|---|
| 723 | FNeedBitmap:=True;
|
|---|
| 724 | ZOrder:=zoBottom;
|
|---|
| 725 | FAutoSize:=False;
|
|---|
| 726 | FStretch:=True;
|
|---|
| 727 | FCenter:=False;
|
|---|
| 728 |
|
|---|
| 729 | FPicture.Create(Self);
|
|---|
| 730 | FPicture.OnChange := PictureChanged;
|
|---|
| 731 | End;
|
|---|
| 732 |
|
|---|
| 733 | Procedure TImage.Change;
|
|---|
| 734 | Begin
|
|---|
| 735 | If FOnChange<>Nil Then FOnChange(Self);
|
|---|
| 736 | End;
|
|---|
| 737 |
|
|---|
| 738 | Procedure TImage.PictureChanged(Sender:TObject);
|
|---|
| 739 | Begin
|
|---|
| 740 | Change;
|
|---|
| 741 | Invalidate;
|
|---|
| 742 | End;
|
|---|
| 743 |
|
|---|
| 744 |
|
|---|
| 745 | Procedure TImage.SetStretch(NewValue:Boolean);
|
|---|
| 746 | Begin
|
|---|
| 747 | FStretch:=NewValue;
|
|---|
| 748 | Invalidate;
|
|---|
| 749 | End;
|
|---|
| 750 |
|
|---|
| 751 | Procedure TImage.SetCenter(NewValue:Boolean);
|
|---|
| 752 | Begin
|
|---|
| 753 | FCenter:=NewValue;
|
|---|
| 754 | Invalidate;
|
|---|
| 755 | End;
|
|---|
| 756 |
|
|---|
| 757 | Procedure TImage.SetBitmap(NewBitmap:TBitmap);
|
|---|
| 758 | Begin
|
|---|
| 759 | Picture.Bitmap := NewBitmap;
|
|---|
| 760 | End;
|
|---|
| 761 |
|
|---|
| 762 | Function TImage.GetBitmap:TBitmap;
|
|---|
| 763 | Begin
|
|---|
| 764 | If ((Picture.HasFormat(TBitmap))Or(Picture.Empty)) Then
|
|---|
| 765 | Result := Picture.Bitmap
|
|---|
| 766 | Else
|
|---|
| 767 | Result:=Nil;
|
|---|
| 768 | End;
|
|---|
| 769 |
|
|---|
| 770 | Function TImage.GetIcon:TIcon;
|
|---|
| 771 | Begin
|
|---|
| 772 | If ((Picture.HasFormat(TIcon))Or(Picture.Empty)) Then
|
|---|
| 773 | Result := Picture.Icon
|
|---|
| 774 | Else
|
|---|
| 775 | Result:=Nil;
|
|---|
| 776 | End;
|
|---|
| 777 |
|
|---|
| 778 | Procedure TImage.SetIcon(NewIcon:TIcon);
|
|---|
| 779 | Begin
|
|---|
| 780 | Picture.Icon:=NewIcon;
|
|---|
| 781 | End;
|
|---|
| 782 |
|
|---|
| 783 | Function TImage.GetGraphic:TGraphic;
|
|---|
| 784 | Begin
|
|---|
| 785 | Result:=Picture.Graphic;
|
|---|
| 786 | End;
|
|---|
| 787 |
|
|---|
| 788 | Procedure TImage.SetGraphic(NewGraphic:TGraphic);
|
|---|
| 789 | Begin
|
|---|
| 790 | Picture.Graphic:=NewGraphic;
|
|---|
| 791 | End;
|
|---|
| 792 |
|
|---|
| 793 | Procedure TImage.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
|
|---|
| 794 | Begin
|
|---|
| 795 | Inherited MouseDown(Button,ShiftState,X,Y);
|
|---|
| 796 |
|
|---|
| 797 | If Button = mbLeft Then
|
|---|
| 798 | If Form Is TForm Then
|
|---|
| 799 | Begin
|
|---|
| 800 | Form.BringToFront;
|
|---|
| 801 |
|
|---|
| 802 | LastMsg.Handled:=True; {!!}
|
|---|
| 803 | LastMsg.Result:=0;
|
|---|
| 804 | End;
|
|---|
| 805 | End;
|
|---|
| 806 |
|
|---|
| 807 | Procedure TImage.Redraw(Const rec:TRect);
|
|---|
| 808 | Var rc:TRect;
|
|---|
| 809 | X,Y:LongInt;
|
|---|
| 810 | aGraphic:TGraphic;
|
|---|
| 811 | Label proceed;
|
|---|
| 812 | Begin
|
|---|
| 813 | If Canvas = Nil Then Exit;
|
|---|
| 814 |
|
|---|
| 815 | If FPicture.Graphic <> Nil Then
|
|---|
| 816 | If not FPicture.Graphic.Empty Then
|
|---|
| 817 | Begin
|
|---|
| 818 | aGraphic := FPicture.Graphic;
|
|---|
| 819 | //clear background for icons and pointers
|
|---|
| 820 | If (aGraphic Is TIcon)
|
|---|
| 821 | Or (aGraphic Is TPointer)
|
|---|
| 822 | Or (aGraphic Is TMetaFile) Then
|
|---|
| 823 | Inherited Redraw(rec);
|
|---|
| 824 | goto proceed; // what is the 60's - AaronL
|
|---|
| 825 | End;
|
|---|
| 826 |
|
|---|
| 827 | Inherited Redraw(rec);
|
|---|
| 828 |
|
|---|
| 829 | If Designed Then
|
|---|
| 830 | Begin
|
|---|
| 831 | Canvas.DeleteClipRegion;
|
|---|
| 832 | Canvas.Brush.color:=color;
|
|---|
| 833 | Canvas.Pen.color:=clBlack;
|
|---|
| 834 | Canvas.TextOut(4,4,Name);
|
|---|
| 835 | rc.Left:=1;
|
|---|
| 836 | rc.Top:=Height-1;
|
|---|
| 837 | rc.Bottom:=1;
|
|---|
| 838 | rc.Right:=Width-1;
|
|---|
| 839 | Canvas.Rectangle(rc);
|
|---|
| 840 | End;
|
|---|
| 841 | Exit;
|
|---|
| 842 |
|
|---|
| 843 | proceed:
|
|---|
| 844 | {If aGraphic Is TBitmap Then
|
|---|
| 845 | Bitmap.RealizePalette(Canvas);}
|
|---|
| 846 | If Stretch Then Canvas.StretchDraw(0,0,Width,Height,aGraphic)
|
|---|
| 847 | Else If ((Center)And(aGraphic.Width<=Width)And(aGraphic.Height<=Height)) Then
|
|---|
| 848 | Begin
|
|---|
| 849 | X:=Width Div 2;
|
|---|
| 850 | Y:=Height Div 2;
|
|---|
| 851 | Dec(X,aGraphic.Width Div 2);
|
|---|
| 852 | Dec(Y,aGraphic.Height Div 2);
|
|---|
| 853 | Canvas.Draw(X,Y,aGraphic);
|
|---|
| 854 | rc.Left:=X;
|
|---|
| 855 | rc.Right:=X+aGraphic.Width-1;
|
|---|
| 856 | rc.Bottom:=Y;
|
|---|
| 857 | rc.Top:=Y+aGraphic.Height-1;
|
|---|
| 858 | Canvas.ExcludeClipRect(rc);
|
|---|
| 859 | Inherited Redraw(rec);
|
|---|
| 860 | End
|
|---|
| 861 | Else
|
|---|
| 862 | Begin
|
|---|
| 863 | Canvas.Draw(0,0,aGraphic);
|
|---|
| 864 | rc.Left:=0;
|
|---|
| 865 | rc.Right:=aGraphic.Width-1;
|
|---|
| 866 | rc.Bottom:=0;
|
|---|
| 867 | rc.Top:=aGraphic.Height-1;
|
|---|
| 868 | Canvas.ExcludeClipRect(rc);
|
|---|
| 869 | Inherited Redraw(rec);
|
|---|
| 870 | End;
|
|---|
| 871 | End;
|
|---|
| 872 |
|
|---|
| 873 | Procedure TImage.SetupShow;
|
|---|
| 874 | Var needBMP:Boolean;
|
|---|
| 875 | aBMP:TBitmap;
|
|---|
| 876 | Begin
|
|---|
| 877 | needBmp := FALSE;
|
|---|
| 878 |
|
|---|
| 879 | If Designed Then
|
|---|
| 880 | If FNeedBitmap Then
|
|---|
| 881 | If ComponentState * [csDetail,csLoaded] = [] Then needBmp := TRUE;
|
|---|
| 882 |
|
|---|
| 883 | If FPicture.Graphic <> Nil Then
|
|---|
| 884 | If not FPicture.Graphic.Empty Then needBMP := FALSE;
|
|---|
| 885 |
|
|---|
| 886 |
|
|---|
| 887 | If needBMP Then
|
|---|
| 888 | Begin
|
|---|
| 889 | aBMP := Bitmap;
|
|---|
| 890 |
|
|---|
| 891 | If CallClassPropertyEditor(aBMP) = peOk Then
|
|---|
| 892 | Begin
|
|---|
| 893 | Width := aBMP.Width;
|
|---|
| 894 | Height := aBMP.Height;
|
|---|
| 895 | End
|
|---|
| 896 | Else
|
|---|
| 897 | Begin
|
|---|
| 898 | //aBMP.Destroy;
|
|---|
| 899 | Bitmap := Nil;
|
|---|
| 900 | End;
|
|---|
| 901 | End;
|
|---|
| 902 |
|
|---|
| 903 | {$IFDEF OS2}
|
|---|
| 904 | If FPicture.Graphic Is TBitmap Then
|
|---|
| 905 | Bitmap.RealizePalette(Canvas);
|
|---|
| 906 | {$ENDIF}
|
|---|
| 907 |
|
|---|
| 908 | Inherited SetupShow;
|
|---|
| 909 | End;
|
|---|
| 910 |
|
|---|
| 911 | Destructor TImage.Destroy;
|
|---|
| 912 | Begin
|
|---|
| 913 | If FPicture <> Nil Then
|
|---|
| 914 | Begin
|
|---|
| 915 | FPicture.Destroy;
|
|---|
| 916 | FPicture := Nil;
|
|---|
| 917 | End;
|
|---|
| 918 |
|
|---|
| 919 | Inherited Destroy;
|
|---|
| 920 | End;
|
|---|
| 921 |
|
|---|
| 922 | Procedure TImage.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
|
|---|
| 923 | Begin
|
|---|
| 924 | If ResName = rnPicture Then
|
|---|
| 925 | Begin
|
|---|
| 926 | If DataLen <> 0 Then Bitmap.ReadSCUResource(rnBitmap,Data,DataLen);
|
|---|
| 927 | End
|
|---|
| 928 | Else Inherited ReadSCUResource(ResName,Data,DataLen);
|
|---|
| 929 | End;
|
|---|
| 930 |
|
|---|
| 931 |
|
|---|
| 932 | Function TImage.WriteSCUResource(Stream:TResourceStream):Boolean;
|
|---|
| 933 | Begin
|
|---|
| 934 | Result := Inherited WriteSCUResource(Stream);
|
|---|
| 935 | If Not Result Then Exit;
|
|---|
| 936 |
|
|---|
| 937 | If FPicture.Graphic Is TBitmap
|
|---|
| 938 | Then Result := Bitmap.WriteSCUResourceName(Stream,rnPicture);
|
|---|
| 939 | End;
|
|---|
| 940 |
|
|---|
| 941 |
|
|---|
| 942 | {
|
|---|
| 943 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
|---|
| 944 | º º
|
|---|
| 945 | º Speed-Pascal/2 Version 2.0 º
|
|---|
| 946 | º º
|
|---|
| 947 | º Speed-Pascal Component Classes (SPCC) º
|
|---|
| 948 | º º
|
|---|
| 949 | º This section: TBevel Class Implementation º
|
|---|
| 950 | º º
|
|---|
| 951 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
|---|
| 952 | º º
|
|---|
| 953 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
|---|
| 954 | }
|
|---|
| 955 |
|
|---|
| 956 | Procedure TBevel.SetupComponent;
|
|---|
| 957 | Begin
|
|---|
| 958 | Inherited SetupComponent;
|
|---|
| 959 |
|
|---|
| 960 | Name:='Bevel';
|
|---|
| 961 | Height:=100;
|
|---|
| 962 | Width:=100;
|
|---|
| 963 | ParentPenColor:=True;
|
|---|
| 964 | ParentColor:=True;
|
|---|
| 965 | CursorTabStop:=False;
|
|---|
| 966 | TabStop:=False;
|
|---|
| 967 | ZOrder:=zoBottom;
|
|---|
| 968 | FShape:=bsBox;
|
|---|
| 969 | FStyle:=bsLowered;
|
|---|
| 970 | Include(ComponentState, csAcceptsControls);
|
|---|
| 971 | End;
|
|---|
| 972 |
|
|---|
| 973 | Procedure TBevel.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
|
|---|
| 974 | Begin
|
|---|
| 975 | Inherited MouseDown(Button,ShiftState,X,Y);
|
|---|
| 976 |
|
|---|
| 977 | If Button = mbLeft Then
|
|---|
| 978 | If Form Is TForm Then
|
|---|
| 979 | Begin
|
|---|
| 980 | Form.BringToFront;
|
|---|
| 981 |
|
|---|
| 982 | LastMsg.Handled:=True; {!!}
|
|---|
| 983 | LastMsg.Result:=0;
|
|---|
| 984 | End;
|
|---|
| 985 | End;
|
|---|
| 986 |
|
|---|
| 987 | Procedure TBevel.SetShape(NewShape:TBevelShape);
|
|---|
| 988 | Begin
|
|---|
| 989 | FShape := NewShape;
|
|---|
| 990 | If Handle <> 0 Then Invalidate;
|
|---|
| 991 | End;
|
|---|
| 992 |
|
|---|
| 993 | Procedure TBevel.SetStyle(NewStyle:TBevelStyle);
|
|---|
| 994 | Begin
|
|---|
| 995 | FStyle := NewStyle;
|
|---|
| 996 | If Handle <> 0 Then Invalidate;
|
|---|
| 997 | End;
|
|---|
| 998 |
|
|---|
| 999 | Procedure TBevel.Redraw(Const rec:TRect);
|
|---|
| 1000 | Var rc1:TRect;
|
|---|
| 1001 | RaisedColor:TColor;
|
|---|
| 1002 | LoweredColor:TColor;
|
|---|
| 1003 | Begin
|
|---|
| 1004 | If Canvas = Nil Then Exit;
|
|---|
| 1005 | Inherited Redraw(rec);
|
|---|
| 1006 |
|
|---|
| 1007 | rc1 := ClientRect;
|
|---|
| 1008 |
|
|---|
| 1009 | If FStyle=bsRaised Then
|
|---|
| 1010 | Begin
|
|---|
| 1011 | RaisedColor:=clWhite;
|
|---|
| 1012 | LoweredColor:=clDkGray;
|
|---|
| 1013 | End
|
|---|
| 1014 | Else
|
|---|
| 1015 | Begin
|
|---|
| 1016 | RaisedColor:=clDkGray;
|
|---|
| 1017 | LoweredColor:=clWhite;
|
|---|
| 1018 | End;
|
|---|
| 1019 |
|
|---|
| 1020 | Case FShape Of
|
|---|
| 1021 | bsBottomLine:
|
|---|
| 1022 | Begin
|
|---|
| 1023 | Canvas.Pen.color:=LoweredColor;
|
|---|
| 1024 | Canvas.Line(rc1.Left,rc1.Bottom,rc1.Right,rc1.Bottom);
|
|---|
| 1025 | Inc(rc1.Bottom);
|
|---|
| 1026 | Canvas.Pen.color:=RaisedColor;
|
|---|
| 1027 | Canvas.Line(rc1.Left,rc1.Bottom,rc1.Right,rc1.Bottom);
|
|---|
| 1028 | End;
|
|---|
| 1029 | bsBox:
|
|---|
| 1030 | Begin
|
|---|
| 1031 | Canvas.ShadowedBorder(rc1,RaisedColor,LoweredColor);
|
|---|
| 1032 | End;
|
|---|
| 1033 | bsFrame:
|
|---|
| 1034 | Begin
|
|---|
| 1035 | DrawSystemFrame(Self,rc1,LoweredColor,RaisedColor);
|
|---|
| 1036 | End;
|
|---|
| 1037 | bsBorder:
|
|---|
| 1038 | Begin
|
|---|
| 1039 | DrawSystemBorder(Self,rc1,bsSingle); {only lowered}
|
|---|
| 1040 | End;
|
|---|
| 1041 | bsLeftLine:
|
|---|
| 1042 | Begin
|
|---|
| 1043 | Canvas.Pen.color:=RaisedColor;
|
|---|
| 1044 | Canvas.Line(rc1.Left,rc1.Top,rc1.Left,rc1.Bottom);
|
|---|
| 1045 | Inc(rc1.Left);
|
|---|
| 1046 | Canvas.Pen.color:=LoweredColor;
|
|---|
| 1047 | Canvas.Line(rc1.Left,rc1.Top,rc1.Left,rc1.Bottom);
|
|---|
| 1048 | End;
|
|---|
| 1049 | bsRightLine:
|
|---|
| 1050 | Begin
|
|---|
| 1051 | Canvas.Pen.color:=LoweredColor;
|
|---|
| 1052 | Canvas.Line(rc1.Right,rc1.Top,rc1.Right,rc1.Bottom);
|
|---|
| 1053 | Dec(rc1.Right);
|
|---|
| 1054 | Canvas.Pen.color:=RaisedColor;
|
|---|
| 1055 | Canvas.Line(rc1.Right,rc1.Top,rc1.Right,rc1.Bottom);
|
|---|
| 1056 | End;
|
|---|
| 1057 | bsTopLine:
|
|---|
| 1058 | Begin
|
|---|
| 1059 | Canvas.Pen.color:=RaisedColor;
|
|---|
| 1060 | Canvas.Line(rc1.Left,rc1.Top,rc1.Right,rc1.Top);
|
|---|
| 1061 | Dec(rc1.Top);
|
|---|
| 1062 | Canvas.Pen.color:=LoweredColor;
|
|---|
| 1063 | Canvas.Line(rc1.Left,rc1.Top,rc1.Right,rc1.Top);
|
|---|
| 1064 | End;
|
|---|
| 1065 | End; {Case}
|
|---|
| 1066 | End;
|
|---|
| 1067 |
|
|---|
| 1068 | {
|
|---|
| 1069 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
|---|
| 1070 | º º
|
|---|
| 1071 | º Speed-Pascal/2 Version 2.0 º
|
|---|
| 1072 | º º
|
|---|
| 1073 | º Speed-Pascal Component Classes (SPCC) º
|
|---|
| 1074 | º º
|
|---|
| 1075 | º This section: TPanel Class Implementation º
|
|---|
| 1076 | º º
|
|---|
| 1077 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
|---|
| 1078 | º º
|
|---|
| 1079 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
|---|
| 1080 | }
|
|---|
| 1081 |
|
|---|
| 1082 | Procedure TPanel.SetupComponent;
|
|---|
| 1083 | Begin
|
|---|
| 1084 | Inherited SetupComponent;
|
|---|
| 1085 |
|
|---|
| 1086 | Name:='Panel';
|
|---|
| 1087 | Caption:=Name;
|
|---|
| 1088 | Height:=100;
|
|---|
| 1089 | Width:=100;
|
|---|
| 1090 | ParentPenColor:=True;
|
|---|
| 1091 | ParentColor:=True;
|
|---|
| 1092 | CursorTabStop:=False;
|
|---|
| 1093 | TabStop:=False;
|
|---|
| 1094 | ZOrder:=zoBottom;
|
|---|
| 1095 | FBevelInner:=bvNone;
|
|---|
| 1096 | FBevelOuter:=bvRaised;
|
|---|
| 1097 | FBevelWidth:=1;
|
|---|
| 1098 | FBorderStyle:=bsNone;
|
|---|
| 1099 | FBorderWidth:=0;
|
|---|
| 1100 | FAlignment:=taCenter;
|
|---|
| 1101 | Include(ComponentState, csAcceptsControls);
|
|---|
| 1102 | End;
|
|---|
| 1103 |
|
|---|
| 1104 | Procedure TPanel.Redraw(Const rec:TRect);
|
|---|
| 1105 | Var OuterRaisedColor:TColor;
|
|---|
| 1106 | OuterLoweredColor:TColor;
|
|---|
| 1107 | InnerRaisedColor:TColor;
|
|---|
| 1108 | InnerLoweredColor:TColor;
|
|---|
| 1109 | rc1:TRect;
|
|---|
| 1110 |
|
|---|
| 1111 | Procedure DrawFrame(rc:TRect;FrameWidth:LongInt;HiColor,LoColor:TColor);
|
|---|
| 1112 | Var PointsArray:Array[0..5] Of TPoint;
|
|---|
| 1113 | offs:LongInt;
|
|---|
| 1114 | Begin
|
|---|
| 1115 | offs := FrameWidth-1;
|
|---|
| 1116 |
|
|---|
| 1117 | If FrameWidth > 1 Then
|
|---|
| 1118 | Begin
|
|---|
| 1119 | PointsArray[0] := Point(rc.Left,rc.Bottom);
|
|---|
| 1120 | PointsArray[1] := Point(rc.Left+offs,rc.Bottom+offs);
|
|---|
| 1121 | PointsArray[2] := Point(rc.Left+offs,rc.Top-offs);
|
|---|
| 1122 | PointsArray[3] := Point(rc.Right-offs,rc.Top-offs);
|
|---|
| 1123 | PointsArray[4] := Point(rc.Right,rc.Top);
|
|---|
| 1124 | PointsArray[5] := Point(rc.Left,rc.Top);
|
|---|
| 1125 | Canvas.Pen.color := HiColor;
|
|---|
| 1126 | Canvas.Polygon(PointsArray);
|
|---|
| 1127 | PointsArray[2] := Point(rc.Right-offs,rc.Bottom+offs);
|
|---|
| 1128 | PointsArray[3] := Point(rc.Right-offs,rc.Top-offs);
|
|---|
| 1129 | PointsArray[4] := Point(rc.Right,rc.Top);
|
|---|
| 1130 | PointsArray[5] := Point(rc.Right,rc.Bottom);
|
|---|
| 1131 | Canvas.Pen.color := LoColor;
|
|---|
| 1132 | Canvas.Polygon(PointsArray);
|
|---|
| 1133 | End
|
|---|
| 1134 | Else Canvas.ShadowedBorder(rc1,HiColor,LoColor);
|
|---|
| 1135 | End;
|
|---|
| 1136 | Begin
|
|---|
| 1137 | If Canvas = Nil Then Exit;
|
|---|
| 1138 |
|
|---|
| 1139 | If FBevelInner = bvRaised Then
|
|---|
| 1140 | Begin
|
|---|
| 1141 | InnerRaisedColor := clBtnHighlight;
|
|---|
| 1142 | InnerLoweredColor := clBtnShadow;
|
|---|
| 1143 | End
|
|---|
| 1144 | Else
|
|---|
| 1145 | Begin
|
|---|
| 1146 | InnerRaisedColor := clBtnShadow;
|
|---|
| 1147 | InnerLoweredColor := clBtnHighlight;
|
|---|
| 1148 | End;
|
|---|
| 1149 |
|
|---|
| 1150 | If FBevelOuter = bvRaised Then
|
|---|
| 1151 | Begin
|
|---|
| 1152 | OuterRaisedColor := clBtnHighlight;
|
|---|
| 1153 | OuterLoweredColor := clBtnShadow;
|
|---|
| 1154 | End
|
|---|
| 1155 | Else
|
|---|
| 1156 | Begin
|
|---|
| 1157 | OuterRaisedColor := clBtnShadow;
|
|---|
| 1158 | OuterLoweredColor := clBtnHighlight;
|
|---|
| 1159 | End;
|
|---|
| 1160 |
|
|---|
| 1161 | rc1 := ClientRect;
|
|---|
| 1162 | DrawSystemBorder(Self,rc1,FBorderStyle);
|
|---|
| 1163 |
|
|---|
| 1164 | If FBevelOuter <> bvNone Then
|
|---|
| 1165 | If FBevelWidth > 0 Then
|
|---|
| 1166 | Begin
|
|---|
| 1167 | DrawFrame(rc1,FBevelWidth,OuterRaisedColor,OuterLoweredColor);
|
|---|
| 1168 | InflateRect(rc1,-FBevelWidth,-FBevelWidth);
|
|---|
| 1169 | End;
|
|---|
| 1170 |
|
|---|
| 1171 | If FBorderWidth > 0 Then
|
|---|
| 1172 | Begin
|
|---|
| 1173 | DrawFrame(rc1,FBorderWidth,color,color);
|
|---|
| 1174 | InflateRect(rc1,-FBorderWidth,-FBorderWidth);
|
|---|
| 1175 | End;
|
|---|
| 1176 |
|
|---|
| 1177 | If FBevelInner <> bvNone Then
|
|---|
| 1178 | If FBevelWidth > 0 Then
|
|---|
| 1179 | Begin
|
|---|
| 1180 | DrawFrame(rc1,FBevelWidth,InnerRaisedColor,InnerLoweredColor);
|
|---|
| 1181 | InflateRect(rc1,-FBevelWidth,-FBevelWidth);
|
|---|
| 1182 | End;
|
|---|
| 1183 |
|
|---|
| 1184 | FInterior := rc1;
|
|---|
| 1185 | DrawText(rec);
|
|---|
| 1186 | End;
|
|---|
| 1187 |
|
|---|
| 1188 | {$HINTS OFF}
|
|---|
| 1189 | Procedure TPanel.DrawText(Const rec:TRect);
|
|---|
| 1190 | Var X,Y,CX,CY:LongInt;
|
|---|
| 1191 | Begin
|
|---|
| 1192 | If Canvas = Nil Then Exit;
|
|---|
| 1193 |
|
|---|
| 1194 | Canvas.FillRect(FInterior,color);
|
|---|
| 1195 | Canvas.SetClipRegion([FInterior]);
|
|---|
| 1196 |
|
|---|
| 1197 | {Draw Caption}
|
|---|
| 1198 | If Caption <> '' Then
|
|---|
| 1199 | Begin
|
|---|
| 1200 | Canvas.GetTextExtent(Caption,CX,CY);
|
|---|
| 1201 | Case FAlignment Of
|
|---|
| 1202 | taLeftJustify: X := FInterior.Left+1;
|
|---|
| 1203 | taRightJustify: X := FInterior.Right-CX;
|
|---|
| 1204 | taCenter: X := (Width-CX) Div 2;
|
|---|
| 1205 | End;
|
|---|
| 1206 | Y := (Height-CY) Div 2;
|
|---|
| 1207 | Canvas.Pen.color := PenColor;
|
|---|
| 1208 | Canvas.Brush.color := color;
|
|---|
| 1209 | Canvas.TextOut(X,Y,Caption);
|
|---|
| 1210 | End;
|
|---|
| 1211 |
|
|---|
| 1212 | Canvas.DeleteClipRegion; {Win95!}
|
|---|
| 1213 | End;
|
|---|
| 1214 | {$HINTS ON}
|
|---|
| 1215 |
|
|---|
| 1216 |
|
|---|
| 1217 | Procedure TPanel.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
|
|---|
| 1218 | Begin
|
|---|
| 1219 | Inherited MouseDown(Button,ShiftState,X,Y);
|
|---|
| 1220 |
|
|---|
| 1221 | If Button = mbLeft Then
|
|---|
| 1222 | If Form Is TForm Then
|
|---|
| 1223 | Begin
|
|---|
| 1224 | Form.BringToFront;
|
|---|
| 1225 |
|
|---|
| 1226 | LastMsg.Handled:=True; {!!}
|
|---|
| 1227 | LastMsg.Result:=0;
|
|---|
| 1228 | End;
|
|---|
| 1229 | End;
|
|---|
| 1230 |
|
|---|
| 1231 |
|
|---|
| 1232 | Procedure TPanel.SetBevelInner(NewBevel:TPanelBevel);
|
|---|
| 1233 | Begin
|
|---|
| 1234 | FBevelInner:=NewBevel;
|
|---|
| 1235 | If Handle<>0 Then Invalidate;
|
|---|
| 1236 | End;
|
|---|
| 1237 |
|
|---|
| 1238 | Procedure TPanel.SetBevelOuter(NewBevel:TPanelBevel);
|
|---|
| 1239 | Begin
|
|---|
| 1240 | FBevelOuter:=NewBevel;
|
|---|
| 1241 | If Handle<>0 Then Invalidate;
|
|---|
| 1242 | End;
|
|---|
| 1243 |
|
|---|
| 1244 | Procedure TPanel.SetBevelWidth(NewWidth:LongInt);
|
|---|
| 1245 | Begin
|
|---|
| 1246 | If NewWidth<0 Then NewWidth:=0;
|
|---|
| 1247 | FBevelWidth:=NewWidth;
|
|---|
| 1248 | If Handle<>0 Then Invalidate;
|
|---|
| 1249 | End;
|
|---|
| 1250 |
|
|---|
| 1251 | Procedure TPanel.SetBorderStyle(NewStyle:TBorderStyle);
|
|---|
| 1252 | Begin
|
|---|
| 1253 | FBorderStyle:=NewStyle;
|
|---|
| 1254 | If Handle<>0 Then Invalidate;
|
|---|
| 1255 | End;
|
|---|
| 1256 |
|
|---|
| 1257 | Procedure TPanel.SetBorderWidth(NewWidth:LongInt);
|
|---|
| 1258 | Begin
|
|---|
| 1259 | If NewWidth<0 Then NewWidth:=0;
|
|---|
| 1260 | FBorderWidth:=NewWidth;
|
|---|
| 1261 | If Handle<>0 Then Invalidate;
|
|---|
| 1262 | End;
|
|---|
| 1263 |
|
|---|
| 1264 | Procedure TPanel.SetAlignment(ta:TAlignment);
|
|---|
| 1265 | Begin
|
|---|
| 1266 | FAlignment:=ta;
|
|---|
| 1267 | If Handle<>0 Then DrawText(ClientRect);
|
|---|
| 1268 | End;
|
|---|
| 1269 |
|
|---|
| 1270 | {$HINTS OFF}
|
|---|
| 1271 | Procedure TPanel.CMTextChanged(Var Msg:TMessage);
|
|---|
| 1272 | Begin
|
|---|
| 1273 | DrawText(ClientRect);
|
|---|
| 1274 | End;
|
|---|
| 1275 | {$HINTS ON}
|
|---|
| 1276 |
|
|---|
| 1277 |
|
|---|
| 1278 | {
|
|---|
| 1279 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
|---|
| 1280 | º º
|
|---|
| 1281 | º Speed-Pascal/2 Version 2.0 º
|
|---|
| 1282 | º º
|
|---|
| 1283 | º Speed-Pascal Component Classes (SPCC) º
|
|---|
| 1284 | º º
|
|---|
| 1285 | º This section: TRadioGroup Class Implementation º
|
|---|
| 1286 | º º
|
|---|
| 1287 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
|---|
| 1288 | º º
|
|---|
| 1289 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
|---|
| 1290 | }
|
|---|
| 1291 |
|
|---|
| 1292 | Procedure TRadioGroup.SetupComponent;
|
|---|
| 1293 | Begin
|
|---|
| 1294 | Inherited SetupComponent;
|
|---|
| 1295 |
|
|---|
| 1296 | Name := 'RadioGroup';
|
|---|
| 1297 | Caption := Name;
|
|---|
| 1298 |
|
|---|
| 1299 | FRadios.Create;
|
|---|
| 1300 | FItems := TStringList.Create;
|
|---|
| 1301 | TStringList(FItems).OnChange := EvItemsChange;
|
|---|
| 1302 | FItemIndex := -1;
|
|---|
| 1303 | FColumns := 1;
|
|---|
| 1304 | End;
|
|---|
| 1305 |
|
|---|
| 1306 |
|
|---|
| 1307 | Procedure TRadioGroup.SetupShow;
|
|---|
| 1308 | Begin
|
|---|
| 1309 | Inherited SetupShow;
|
|---|
| 1310 |
|
|---|
| 1311 | UpdateRadios;
|
|---|
| 1312 | SetItemIndex(FItemIndex);
|
|---|
| 1313 | ArrangeRadios;
|
|---|
| 1314 | End;
|
|---|
| 1315 |
|
|---|
| 1316 |
|
|---|
| 1317 | Destructor TRadioGroup.Destroy;
|
|---|
| 1318 | Begin
|
|---|
| 1319 | SetRadioCount(0);
|
|---|
| 1320 | FRadios.Destroy;
|
|---|
| 1321 | FRadios := Nil;
|
|---|
| 1322 | TStringList(FItems).OnChange := Nil;
|
|---|
| 1323 | FItems.Destroy;
|
|---|
| 1324 | FItems := Nil;
|
|---|
| 1325 |
|
|---|
| 1326 | Inherited Destroy;
|
|---|
| 1327 | End;
|
|---|
| 1328 |
|
|---|
| 1329 |
|
|---|
| 1330 | Procedure TRadioGroup.Resize;
|
|---|
| 1331 | Begin
|
|---|
| 1332 | Inherited Resize;
|
|---|
| 1333 |
|
|---|
| 1334 | ArrangeRadios;
|
|---|
| 1335 | End;
|
|---|
| 1336 |
|
|---|
| 1337 |
|
|---|
| 1338 | Procedure TRadioGroup.FontChange;
|
|---|
| 1339 | Var I:LongInt;
|
|---|
| 1340 | Radio:TRadioButton;
|
|---|
| 1341 | Begin
|
|---|
| 1342 | Inherited FontChange;
|
|---|
| 1343 |
|
|---|
| 1344 | For I := 0 To FRadios.Count-1 Do
|
|---|
| 1345 | Begin
|
|---|
| 1346 | Radio := TRadioButton(FRadios.Items[I]);
|
|---|
| 1347 | Radio.Font := Font;
|
|---|
| 1348 | End;
|
|---|
| 1349 | ArrangeRadios;
|
|---|
| 1350 | End;
|
|---|
| 1351 |
|
|---|
| 1352 |
|
|---|
| 1353 | Procedure TRadioGroup.Click;
|
|---|
| 1354 | Begin
|
|---|
| 1355 | If FOnClick <> Nil Then FOnClick(Self);
|
|---|
| 1356 | End;
|
|---|
| 1357 |
|
|---|
| 1358 |
|
|---|
| 1359 | Procedure TRadioGroup.SetItemIndex(Value:LongInt);
|
|---|
| 1360 | Begin
|
|---|
| 1361 | If ComponentState * [csReading] <> [] Then
|
|---|
| 1362 | Begin
|
|---|
| 1363 | FItemIndex := Value;
|
|---|
| 1364 | Exit;
|
|---|
| 1365 | End;
|
|---|
| 1366 |
|
|---|
| 1367 | If Value < 0 Then Value := -1;
|
|---|
| 1368 | If Value >= FItems.Count Then Value := FItems.Count-1;
|
|---|
| 1369 |
|
|---|
| 1370 | if Handle <> 0 then
|
|---|
| 1371 | begin
|
|---|
| 1372 | // Update the radio buttons
|
|---|
| 1373 | {deselect old because New Value can be < 0}
|
|---|
| 1374 | If (FItemIndex >= 0) And (FItemIndex < FRadios.Count)
|
|---|
| 1375 | Then TRadioButton(FRadios[FItemIndex]).Checked := False;
|
|---|
| 1376 |
|
|---|
| 1377 | FItemIndex := Value;
|
|---|
| 1378 | If FItemIndex >= 0 {Select New} Then
|
|---|
| 1379 | Begin
|
|---|
| 1380 | TRadioButton(FRadios[FItemIndex]).Checked := True;
|
|---|
| 1381 | If HasFocus then
|
|---|
| 1382 | TRadioButton(FRadios[FItemIndex]).Focus;
|
|---|
| 1383 | End;
|
|---|
| 1384 | UpdateTabList;
|
|---|
| 1385 |
|
|---|
| 1386 | end
|
|---|
| 1387 | else
|
|---|
| 1388 | begin
|
|---|
| 1389 | // No radios to update yet - AaronL
|
|---|
| 1390 | FItemIndex := Value;
|
|---|
| 1391 | end;
|
|---|
| 1392 |
|
|---|
| 1393 | ItemIndexChange;
|
|---|
| 1394 | End;
|
|---|
| 1395 |
|
|---|
| 1396 |
|
|---|
| 1397 | Procedure TRadioGroup.ItemIndexChange;
|
|---|
| 1398 | Begin
|
|---|
| 1399 | End;
|
|---|
| 1400 |
|
|---|
| 1401 |
|
|---|
| 1402 | Procedure TRadioGroup.SetColumns(Value:LongInt);
|
|---|
| 1403 | Begin
|
|---|
| 1404 | If Value <= 0 Then Value := 1;
|
|---|
| 1405 | If FColumns <> Value Then
|
|---|
| 1406 | Begin
|
|---|
| 1407 | FColumns := Value;
|
|---|
| 1408 | ArrangeRadios;
|
|---|
| 1409 | End;
|
|---|
| 1410 | End;
|
|---|
| 1411 |
|
|---|
| 1412 |
|
|---|
| 1413 | Procedure TRadioGroup.SetItems(Value:TStrings);
|
|---|
| 1414 | Begin
|
|---|
| 1415 | If Value <> FItems Then FItems.Assign(Value);
|
|---|
| 1416 | End;
|
|---|
| 1417 |
|
|---|
| 1418 |
|
|---|
| 1419 | Procedure TRadioGroup.SetRadioCount(Value:LongInt);
|
|---|
| 1420 | Var Radio:TRadioButton;
|
|---|
| 1421 | Begin
|
|---|
| 1422 | While FRadios.Count < Value Do
|
|---|
| 1423 | Begin
|
|---|
| 1424 | Radio.Create(Self);
|
|---|
| 1425 | Include(Radio.ComponentState, csDetail);
|
|---|
| 1426 | Radio.Font := Font;
|
|---|
| 1427 | Radio.OnClick := EvRadioClick;
|
|---|
| 1428 | Radio.TabStop := True;
|
|---|
| 1429 | Radio.CursorTabStop := true;
|
|---|
| 1430 | FRadios.Add(Radio);
|
|---|
| 1431 | End;
|
|---|
| 1432 | While FRadios.Count > Value Do
|
|---|
| 1433 | Begin
|
|---|
| 1434 | Radio := TRadioButton(FRadios.Last);
|
|---|
| 1435 | FRadios.Remove(Radio);
|
|---|
| 1436 | Radio.Destroy;
|
|---|
| 1437 | End;
|
|---|
| 1438 | End;
|
|---|
| 1439 |
|
|---|
| 1440 |
|
|---|
| 1441 | Function TRadioGroup.GetItemsEnabled(Index:LongInt):Boolean;
|
|---|
| 1442 | Var Radio:TRadioButton;
|
|---|
| 1443 | Begin
|
|---|
| 1444 | Radio := TRadioButton(FRadios.Items[Index]);
|
|---|
| 1445 | Result := Radio.Enabled;
|
|---|
| 1446 | End;
|
|---|
| 1447 |
|
|---|
| 1448 |
|
|---|
| 1449 | Procedure TRadioGroup.SetItemsEnabled(Index:LongInt;Value:Boolean);
|
|---|
| 1450 | Var Radio:TRadioButton;
|
|---|
| 1451 | Begin
|
|---|
| 1452 | Radio := TRadioButton(FRadios.Items[Index]);
|
|---|
| 1453 | Radio.Enabled := Value;
|
|---|
| 1454 | End;
|
|---|
| 1455 |
|
|---|
| 1456 |
|
|---|
| 1457 | Procedure TRadioGroup.UpdateRadios;
|
|---|
| 1458 | Var I:LongInt;
|
|---|
| 1459 | Radio:TRadioButton;
|
|---|
| 1460 | Begin
|
|---|
| 1461 | SetRadioCount(FItems.Count);
|
|---|
| 1462 | For I := 0 To FItems.Count- 1 Do
|
|---|
| 1463 | Begin
|
|---|
| 1464 | Radio := TRadioButton(FRadios.Items[I]);
|
|---|
| 1465 | Radio.Caption := FItems[I];
|
|---|
| 1466 | End;
|
|---|
| 1467 | SetItemIndex(FItemIndex);
|
|---|
| 1468 | ArrangeRadios;
|
|---|
| 1469 | End;
|
|---|
| 1470 |
|
|---|
| 1471 |
|
|---|
| 1472 | Procedure TRadioGroup.ArrangeRadios;
|
|---|
| 1473 | Const Margin=10;
|
|---|
| 1474 | Var I:LongInt;
|
|---|
| 1475 | Radio:TRadioButton;
|
|---|
| 1476 | RadioWidth:LongInt;
|
|---|
| 1477 | RadioHeight:LongInt;
|
|---|
| 1478 | RadiosPerColumn:LongInt;
|
|---|
| 1479 | XPos,YPos:LongInt;
|
|---|
| 1480 | rc:TRect;
|
|---|
| 1481 | Begin
|
|---|
| 1482 | If Handle = 0 Then Exit;
|
|---|
| 1483 | If FRadios.Count = 0 Then Exit;
|
|---|
| 1484 |
|
|---|
| 1485 | rc := ClientRect;
|
|---|
| 1486 | Inc(rc.Left,Margin);
|
|---|
| 1487 | Inc(rc.Bottom,Margin);
|
|---|
| 1488 | Dec(rc.Right,Margin);
|
|---|
| 1489 | Dec(rc.Top,Margin+Font.Height);
|
|---|
| 1490 |
|
|---|
| 1491 | RadiosPerColumn := (FRadios.Count + FColumns - 1) Div FColumns;
|
|---|
| 1492 | RadioWidth := (rc.Right - rc.Left) Div FColumns;
|
|---|
| 1493 | RadioHeight := (rc.Top - rc.Bottom) Div RadiosPerColumn;
|
|---|
| 1494 |
|
|---|
| 1495 | XPos := rc.Left;
|
|---|
| 1496 | YPos := rc.Top - RadioHeight;
|
|---|
| 1497 | For I := 0 To FRadios.Count-1 Do
|
|---|
| 1498 | Begin
|
|---|
| 1499 | Radio := TRadioButton(FRadios[I]);
|
|---|
| 1500 | Radio.SetWindowPos(XPos,YPos,RadioWidth,RadioHeight);
|
|---|
| 1501 | If Radio.parent = Nil Then Radio.parent := Self;
|
|---|
| 1502 |
|
|---|
| 1503 | If ((I+1) Mod RadiosPerColumn) = 0 Then
|
|---|
| 1504 | Begin
|
|---|
| 1505 | YPos := rc.Top - RadioHeight;
|
|---|
| 1506 | Inc(XPos,RadioWidth);
|
|---|
| 1507 | End
|
|---|
| 1508 | Else Dec(YPos,RadioHeight);
|
|---|
| 1509 | End;
|
|---|
| 1510 | End;
|
|---|
| 1511 |
|
|---|
| 1512 |
|
|---|
| 1513 | {$HINTS OFF}
|
|---|
| 1514 | Procedure TRadioGroup.EvItemsChange(Sender:TObject);
|
|---|
| 1515 | Begin
|
|---|
| 1516 | If ComponentState * [csReading] = [] Then
|
|---|
| 1517 | Begin
|
|---|
| 1518 | UpdateRadios;
|
|---|
| 1519 | End;
|
|---|
| 1520 | End;
|
|---|
| 1521 | {$HINTS ON}
|
|---|
| 1522 |
|
|---|
| 1523 | Procedure TRadioGroup.EvRadioClick(Sender:TObject);
|
|---|
| 1524 | Begin
|
|---|
| 1525 | FItemIndex := FRadios.IndexOf(Sender);
|
|---|
| 1526 |
|
|---|
| 1527 | UpdateTabList;
|
|---|
| 1528 | ItemIndexChange;
|
|---|
| 1529 | Click;
|
|---|
| 1530 | End;
|
|---|
| 1531 |
|
|---|
| 1532 |
|
|---|
| 1533 | function TRadioGroup.GetTabStop:boolean;
|
|---|
| 1534 | Begin
|
|---|
| 1535 | result := FIsTabStop;
|
|---|
| 1536 | End;
|
|---|
| 1537 |
|
|---|
| 1538 | procedure TRadioGroup.UpdateTabList;
|
|---|
| 1539 | Begin
|
|---|
| 1540 | If Handle = 0 then
|
|---|
| 1541 | exit;
|
|---|
| 1542 | if FTabList = nil then
|
|---|
| 1543 | FTabList := TList.Create;
|
|---|
| 1544 | FTabList.Clear;
|
|---|
| 1545 | If not FIsTabStop then
|
|---|
| 1546 | exit;
|
|---|
| 1547 | if FRadios.Count = 0 then
|
|---|
| 1548 | exit;
|
|---|
| 1549 |
|
|---|
| 1550 | If FItemIndex >= 0 {Select New} Then
|
|---|
| 1551 | Begin
|
|---|
| 1552 | FTabList.Add(FRadios[FItemIndex]);
|
|---|
| 1553 | End
|
|---|
| 1554 | Else If FRadios.Count > 0 Then
|
|---|
| 1555 | Begin
|
|---|
| 1556 | // tabbing will go to the first radio...
|
|---|
| 1557 | FTabList.Add(FRadios[0]);
|
|---|
| 1558 | End;
|
|---|
| 1559 | End;
|
|---|
| 1560 |
|
|---|
| 1561 | procedure TRadioGroup.SetTabStop(Value:boolean);
|
|---|
| 1562 | Begin
|
|---|
| 1563 | FIsTabStop := Value;
|
|---|
| 1564 | UpdateTabList;
|
|---|
| 1565 | End;
|
|---|
| 1566 |
|
|---|
| 1567 | procedure TRadioGroup.WMFocussing( Var Msg: TMessage );
|
|---|
| 1568 | Begin
|
|---|
| 1569 | if FItemIndex <> -1 then
|
|---|
| 1570 | Msg.Result := LONGWORD( FRadios[ FItemIndex ] );
|
|---|
| 1571 | Msg.Handled := true;
|
|---|
| 1572 | End;
|
|---|
| 1573 |
|
|---|
| 1574 |
|
|---|
| 1575 | Function TRadioGroup.WriteSCUResource(Stream:TResourceStream):Boolean;
|
|---|
| 1576 | Var aText:PChar;
|
|---|
| 1577 | Begin
|
|---|
| 1578 | Result := Inherited WriteSCUResource(Stream);
|
|---|
| 1579 | If Not Result Then Exit;
|
|---|
| 1580 |
|
|---|
| 1581 | aText := Items.GetText;
|
|---|
| 1582 | If aText <> Nil Then
|
|---|
| 1583 | Begin
|
|---|
| 1584 | Result := Stream.NewResourceEntry(rnItems,aText^,Length(aText^)+1);
|
|---|
| 1585 | StrDispose(aText);
|
|---|
| 1586 | End;
|
|---|
| 1587 | End;
|
|---|
| 1588 |
|
|---|
| 1589 |
|
|---|
| 1590 | Procedure TRadioGroup.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
|
|---|
| 1591 | Var aText:PChar;
|
|---|
| 1592 | Begin
|
|---|
| 1593 | If ResName = rnItems Then
|
|---|
| 1594 | Begin
|
|---|
| 1595 | aText := @Data;
|
|---|
| 1596 | Items.SetText(aText);
|
|---|
| 1597 | End
|
|---|
| 1598 | Else Inherited ReadSCUResource(ResName,Data,DataLen)
|
|---|
| 1599 | End;
|
|---|
| 1600 |
|
|---|
| 1601 |
|
|---|
| 1602 | {
|
|---|
| 1603 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
|---|
| 1604 | º º
|
|---|
| 1605 | º Speed-Pascal/2 Version 2.0 º
|
|---|
| 1606 | º º
|
|---|
| 1607 | º Speed-Pascal Component Classes (SPCC) º
|
|---|
| 1608 | º º
|
|---|
| 1609 | º This section: TPaintBox Class Implementation º
|
|---|
| 1610 | º º
|
|---|
| 1611 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
|---|
| 1612 | º º
|
|---|
| 1613 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
|---|
| 1614 | }
|
|---|
| 1615 |
|
|---|
| 1616 | Procedure TPaintBox.SetupComponent;
|
|---|
| 1617 | Begin
|
|---|
| 1618 | Inherited SetupComponent;
|
|---|
| 1619 | Name:='PaintBox';
|
|---|
| 1620 | Height:=200;
|
|---|
| 1621 | Width:=200;
|
|---|
| 1622 | ParentPenColor:=True;
|
|---|
| 1623 | ParentColor:=True;
|
|---|
| 1624 | TabStop:=False;
|
|---|
| 1625 | ZOrder:=zoBottom;
|
|---|
| 1626 | End;
|
|---|
| 1627 |
|
|---|
| 1628 |
|
|---|
| 1629 | Procedure TPaintBox.Redraw(Const rec:TRect);
|
|---|
| 1630 | Var rc:TRect;
|
|---|
| 1631 | Begin
|
|---|
| 1632 | Inherited Redraw(rec);
|
|---|
| 1633 |
|
|---|
| 1634 | If Designed Then
|
|---|
| 1635 | Begin
|
|---|
| 1636 | rc:=ClientRect;
|
|---|
| 1637 | Canvas.Brush.color:=color;
|
|---|
| 1638 | Canvas.Pen.color:=clBlack;
|
|---|
| 1639 | Canvas.TextOut(20,20,'PaintBox');
|
|---|
| 1640 | Canvas.Pen.Style := psDash;
|
|---|
| 1641 | Canvas.Brush.Style := bsClear;
|
|---|
| 1642 | Canvas.Rectangle(rc);
|
|---|
| 1643 | End;
|
|---|
| 1644 | End;
|
|---|
| 1645 |
|
|---|
| 1646 |
|
|---|
| 1647 | Begin
|
|---|
| 1648 | End.
|
|---|
| 1649 |
|
|---|
