?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
initial commit
[rofl0r-KOL.git] / mckCtrls.pas
bloba086d2568a091e74ca007852edc63c8975c8d723
1 {=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
2
3 KKKKK KKKKK OOOOOOOOO LLLLL
4 KKKKK KKKKK OOOOOOOOOOOOO LLLLL
5 KKKKK KKKKK OOOOO OOOOO LLLLL
6 KKKKK KKKKK OOOOO OOOOO LLLLL
7 KKKKKKKKKK OOOOO OOOOO LLLLL
8 KKKKK KKKKK OOOOO OOOOO LLLLL
9 KKKKK KKKKK OOOOO OOOOO LLLLL
10 KKKKK KKKKK OOOOOOOOOOOOO LLLLLLLLLLLLL kkkkk
11 KKKKK KKKKK OOOOOOOOO LLLLLLLLLLLLL kkkkk
12 kkkkk
13 mmmmm mmmmm mmmmmm cccccccccccc kkkkk kkkkk
14 mmmmmmmm mmmmm mmmmm cccccc ccccc kkkkk kkkkk
15 mmmmmmmm mmmmm mmmmm cccccc kkkkkkkk
16 mmmmm mmmmm mmmmm cccccc ccccc kkkkk kkkkk
17 mmmmm mmmmm mmmmm cccccccccccc kkkkk kkkkk
18
19 Key Objects Library (C) 2000 by Kladov Vladimir.
20 KOL Mirror Classes Kit (C) 2000 by Kladov Vladimir.
21 }
22 unit mckCtrls;
23 {
24 This unit contains definitions for mirrors of the most of visual controls,
25 defined in KOL. This mirror objects are placed on form at design time and
26 behave itselves like usual VCL visual components (controls). But after
27 compiling of the project (and at run time) these are transformed to poor KOL
28 controls, so all bloats of VCL are removed and executable file become very small.
29
30 Äàííûé ìîäóëü ñîäåðæèò îïðåäåëåíèå çåðêàë äëÿ áîëüøèíñòâà âèçóàëüíûõ îáúåêòîâ,
31 îïðåäåëåííûõ â áèáëèîòåêå KOL. Çåðêàëüíûå îáúåêòû ïîìåùàþòñÿ íà ôîðìó âî âðåìÿ
32 ïðîåêòèðîâàíèÿ è âåäóò ñåáÿ òàê æå, êàê îáû÷íûå âèçóàëüíûå îáúåêòû VCL. Íî
33 ïîñëå êîìïèëÿöèè ïðîåêòà (è âî âðåìÿ èñïîëíåíèÿ) îíè òðàíñôîðìèðóþòñÿ â
34 îáúåêòû KOL, òàê ÷òî âñå "íàâîðîòû" VCL óäàëÿþòñÿ è èñïîëíèìûé ôàéë ñòàíîâèòñÿ
35 î÷åíü ìàëåíüêèì.
36 }
37
38 interface
39
40 {$I KOLDEF.INC}
41
42 uses KOL, Classes, Forms, Controls, Dialogs, Windows, Messages, extctrls,
43 stdctrls, comctrls, CommCtrl, SysUtils, Graphics, mirror, ShellAPI,
44 mckObjs,
45 //////////////////////////////////////////////////
46 {$IFDEF _D6orHigher} //
47 DesignIntf, DesignEditors, DesignConst, //
48 Variants, //
49 {$ELSE} //
50 //////////////////////////////////////////////////
51 DsgnIntf,
52 //////////////////////////////////////////////////////////
53 {$ENDIF} //
54 mckToolbarEditor, mckLVColumnsEditor
55 ;
56
57 type
58
59 //============================================================================
60 //---- MIRROR FOR A BUTTON ----
61 //---- ÇÅÐÊÀËÎ ÄËß ÊÍÎÏÊÈ ----
62 TKOLButton = class(TKOLControl)
63 private
64 FpopupMenu: TKOLPopupMenu;
65 FLikeSpeedButton: Boolean;
66 Fimage: TPicture;
67 FFlat: Boolean;
68 procedure SetpopupMenu(const Value: TKOLPopupMenu);
69 procedure SetLikeSpeedButton(const Value: Boolean);
70 procedure Setimage(const Value: TPicture);
71 procedure SetFlat(const Value: Boolean);
72 protected
73 function TabStopByDefault: Boolean; override;
74 procedure FirstCreate; override;
75 function GenerateTransparentInits: String; override;
76 function SetupParams( const AName, AParent: String ): String; override;
77 procedure SetupColor( SL: TStrings; const AName: String ); override;
78 procedure SetupFont( SL: TStrings; const AName: String ); override;
79 procedure SetupTextAlign( SL: TStrings; const AName: String ); override;
80 function ClientMargins: TRect; override;
81 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
82 function CanNotChangeFontColor: Boolean; override;
83 function DefaultParentColor: Boolean; override;
84 function CanChangeColor: Boolean; override;
85 procedure Paint; override;
86 function WYSIWIGPaintImplemented: Boolean; override;
87 function NoDrawFrame: Boolean; override;
88 procedure CreateKOLControl(Recreating: boolean); override;
89 function ImageResourceName: String;
90 function TypeName: String; override;
91 public
92 constructor Create( AOwner: TComponent ); override;
93 destructor Destroy; override;
94 published
95 property TextAlign;
96 property VerticalAlign;
97 property TabStop;
98 property TabOrder;
99 property OnEnter;
100 property OnLeave;
101 property OnKeyDown;
102 property OnKeyUp;
103 property OnChar;
104 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
105 property LikeSpeedButton: Boolean read FLikeSpeedButton write SetLikeSpeedButton;
106 property autoSize;
107 property DefaultBtn;
108 property CancelBtn;
109 property image: TPicture read Fimage write Setimage;
110 property action;
111 property windowed;
112 property Flat: Boolean read FFlat write SetFlat; // only for not windowed ?
113 property WordWrap;
114 end;
115
116 //============================================================================
117 //---- MIRROR FOR A BIT BUTTON ----
118 //---- ÇÅÐÊÀËÎ ÄËß ÐÈÑÎÂÀÍÍÎÉ ÊÍÎÏÊÈ ----
119 TKOLBitBtn = class(TKOLControl)
120 private
121 FOptions: TBitBtnOptions;
122 FGlyphBitmap: TBitmap;
123 FGlyphCount: Integer;
124 FImageList: TKOLImageList;
125 FGlyphLayout: TGlyphLayout;
126 FImageIndex: Integer;
127 FOnTestMouseOver: TOnTestMouseOver;
128 FpopupMenu: TKOLPopupMenu;
129 FLikeSpeedButton: Boolean;
130 FRepeatInterval: Integer;
131 FFlat: Boolean;
132 FautoAdjustSize: Boolean;
133 FBitBtnDrawMnemonic: Boolean;
134 FTextShiftY: Integer;
135 FTextShiftX: Integer;
136 procedure SetOptions(Value: TBitBtnOptions);
137 procedure SetGlyphBitmap(const Value: TBitmap);
138 procedure SetGlyphCount(Value: Integer);
139 procedure SetImageList(const Value: TKOLImageList);
140 procedure SetGlyphLayout(const Value: TGlyphLayout);
141 procedure SetImageIndex(const Value: Integer);
142 procedure RecalcSize;
143 procedure SetOnTestMouseOver(const Value: TOnTestMouseOver);
144 procedure SetautoAdjustSize(const Value: Boolean);
145 procedure SetpopupMenu(const Value: TKOLPopupMenu);
146 procedure SetLikeSpeedButton(const Value: Boolean);
147 procedure SetRepeatInterval(const Value: Integer);
148 procedure SetFlat(const Value: Boolean);
149 procedure SetBitBtnDrawMnemonic(const Value: Boolean);
150 procedure SetTextShiftX(const Value: Integer);
151 procedure SetTextShiftY(const Value: Integer);
152 protected
153 function TabStopByDefault: Boolean; override;
154 procedure FirstCreate; override;
155 function GenerateTransparentInits: String; override;
156 function SetupParams( const AName, AParent: String ): String; override;
157 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
158 procedure SetupTextAlign( SL: TStrings; const AName: String ); override;
159 procedure AssignEvents( SL: TStringList; const AName: String ); override;
160 function ClientMargins: TRect; override;
161 procedure AutoSizeNow; override;
162 procedure CreateKOLControl(Recreating: boolean); override;
163 function NoDrawFrame: Boolean; override;
164 public
165 constructor Create( AOwner: TComponent ); override;
166 procedure NotifyLinkedComponent( Sender: TObject; Operation: TNotifyOperation ); override;
167 destructor Destroy; override;
168 published
169 property options: TBitBtnOptions read FOptions write SetOptions;
170 property glyphBitmap: TBitmap read FGlyphBitmap write SetGlyphBitmap;
171 property glyphCount: Integer read FGlyphCount write SetGlyphCount;
172 property glyphLayout: TGlyphLayout read FGlyphLayout write SetGlyphLayout;
173 property imageList: TKOLImageList read FImageList write SetImageList;
174 property imageIndex: Integer read FImageIndex write SetImageIndex;
175 property TextAlign;
176 property VerticalAlign;
177 property TabStop;
178 property TabOrder;
179 property Transparent;
180 property OnEnter;
181 property OnLeave;
182 property OnKeyDown;
183 property OnKeyUp;
184 property OnChar;
185 property OnChange;
186 property OnBitBtnDraw;
187 property OnTestMouseOver: TOnTestMouseOver read FOnTestMouseOver write SetOnTestMouseOver;
188 property autoAdjustSize: Boolean read FautoAdjustSize write SetautoAdjustSize;
189 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
190 property LikeSpeedButton: Boolean read FLikeSpeedButton write SetLikeSpeedButton;
191 property RepeatInterval: Integer read FRepeatInterval write SetRepeatInterval;
192 property Flat: Boolean read FFlat write SetFlat;
193 property autoSize;
194 property BitBtnDrawMnemonic: Boolean read FBitBtnDrawMnemonic write SetBitBtnDrawMnemonic;
195 property TextShiftX: Integer read FTextShiftX write SetTextShiftX;
196 property TextShiftY: Integer read FTextShiftY write SetTextShiftY;
197 property DefaultBtn;
198 property CancelBtn;
199 property Brush;
200 property action;
201 end;
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225 //============================================================================
226 //---- MIRROR FOR A LABEL ----
227 //---- ÇÅÐÊÀËÎ ÄËß ÌÅÒÊÈ ----
228 TKOLLabel = class(TKOLControl)
229 private
230 FpopupMenu: TKOLPopupMenu;
231 FShowAccelChar: Boolean;
232 function Get_VertAlign: TVerticalAlign;
233 procedure Set_VertAlign(const Value: TVerticalAlign);
234 procedure SetpopupMenu(const Value: TKOLPopupMenu);
235 procedure SetShowAccelChar(const Value: Boolean);
236 protected
237 fTabOrder: Integer;
238 function AdjustVerticalAlign( Value: TVerticalAlign ): TVerticalAlign; virtual;
239 procedure FirstCreate; override;
240 function SetupParams( const AName, AParent: String ): String; override;
241 procedure SetupTextAlign( SL: TStrings; const AName: String ); override;
242 function GetTaborder: Integer; override;
243 function TypeName: String; override;
244 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String );
245 override;
246 procedure CallInheritedPaint;
247 procedure Paint; override;
248 function WYSIWIGPaintImplemented: Boolean; override;
249 procedure Loaded; override;
250 public
251 constructor Create( AOwner: TComponent ); override;
252 published
253 property Transparent;
254 property TextAlign;
255 property VerticalAlign: TVerticalAlign read Get_VertAlign write Set_VertAlign;
256 property wordWrap;
257 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
258 property autoSize;
259 property Brush;
260 property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar;
261 property windowed;
262 end;
263
264
265 //============================================================================
266 //---- MIRROR FOR A LABEL EFFECT ----
267 //---- ÇÅÐÊÀËÎ ÄËß ÌÅÒÊÈ Ñ ÝÔÔÅÊÒÀÌÈ ----
268 TKOLLabelEffect = class( TKOLLabel )
269 private
270 FShadowDeep: Integer;
271 FColor2: TColor;
272 procedure SetShadowDeep(const Value: Integer);
273 procedure SetColor2(const Value: TColor);
274 protected
275 function AdjustVerticalAlign( Value: TVerticalAlign ): TVerticalAlign; override;
276 function SetupParams( const AName, AParent: String ): String; override;
277 procedure SetupTextAlign( SL: TStrings; const AName: String ); override;
278 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
279 function AutoWidth( Canvas: graphics.TCanvas ): Integer; override;
280 function AutoHeight( Canvas: graphics.TCanvas ): Integer; override;
281 procedure Paint; override;
282 public
283 constructor Create( AOwner: TComponent ); override;
284 published
285 property ShadowDeep: Integer read FShadowDeep write SetShadowDeep;
286 property Color2: TColor read FColor2 write SetColor2;
287 property autoSize;
288 property Ctl3D;
289 property Brush;
290 property wordwrap;
291 end;
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309 //============================================================================
310 //---- MIRROR FOR A PANEL ----
311 //---- ÇÅÐÊÀËÎ ÄËß ÏÀÍÅËÈ ----
312 TKOLPanel = class(TKOLControl)
313 private
314 FEdgeStyle: TEdgeStyle;
315 FpopupMenu: TKOLPopupMenu;
316 FShowAccelChar: Boolean;
317 procedure SetEdgeStyle(const Value: TEdgeStyle);
318 procedure SetpopupMenu(const Value: TKOLPopupMenu);
319 procedure SetShowAccelChar(const Value: Boolean);
320 protected
321 function Get_VA: TVerticalAlign;
322 procedure Set_VA(const Value: TVerticalAlign); virtual;
323 function SetupParams( const AName, AParent: String ): String; override;
324 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
325 procedure SetupConstruct( SL: TStringList; const AName, AParent, Prefix: String ); override;
326 procedure SetupTextAlign( SL: TStrings; const AName: String ); override;
327 function ClientMargins: TRect; override;
328 function RefName: String; override;
329 procedure Paint; override;
330 function WYSIWIGPaintImplemented: Boolean; override;
331 function NoDrawFrame: Boolean; override;
332 procedure SetCaption( const Value: String ); override;
333 public
334 constructor Create( AOwner: TComponent ); override;
335 destructor Destroy; override;
336 published
337 property Transparent;
338 property TextAlign;
339 property edgeStyle: TEdgeStyle read FEdgeStyle write SetEdgeStyle;
340 property TabOrder;
341 property VerticalAlign: TVerticalAlign read Get_VA write Set_VA;
342 property Border;
343 property MarginTop;
344 property MarginBottom;
345 property MarginLeft;
346 property MarginRight;
347 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
348 property Brush;
349 property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar;
350 end;
351
352 //============================================================================
353 //---- MIRROR FOR MDI CLIENT ----
354 //---- ÇÅÐÊÀËÎ ÄËß MDI ÊËÈÅÍÒÀ ----
355 TKOLMDIClient = class(TKOLControl)
356 private
357 FTimer: TTimer;
358 procedure Tick( Sender: TObject );
359 protected
360 function SetupParams( const AName, AParent: String ): String; override;
361 public
362 constructor Create( AOwner: TComponent ); override;
363 destructor Destroy; override;
364 published
365 property TabOrder;
366 end;
367
368
369 //===========================================================================
370 //---- MIRROR FOR A GRADIENT PANEL
371 //---- ÇÅÐÊÀËÎ ÄËß ÃÐÀÄÈÅÍÒÍÎÉ ÏÀÍÅËÈ
372 TKOLGradientPanel = class(TKOLControl)
373 private
374 FColor1: TColor;
375 FColor2: TColor;
376 FpopupMenu: TKOLPopupMenu;
377 FgradientLayout: TGradientLayout;
378 FgradientStyle: TGradientStyle;
379 procedure SetColor1(const Value: TColor);
380 procedure SetColor2(const Value: TColor);
381 procedure SetpopupMenu(const Value: TKOLPopupMenu);
382 procedure SetgradientLayout(const Value: TGradientLayout);
383 procedure SetgradientStyle(const Value: TGradientStyle);
384 protected
385 function TabStopByDefault: Boolean; override;
386 function TypeName: String; override;
387 function SetupParams( const AName, AParent: String ): String; override;
388 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
389 procedure Paint; override;
390 function WYSIWIGPaintImplemented: Boolean; override;
391 function NoDrawFrame: Boolean; override;
392 public
393 constructor Create( AOwner: TComponent ); override;
394 published
395 property Transparent;
396 property Color1: TColor read FColor1 write SetColor1;
397 property Color2: TColor read FColor2 write SetColor2;
398 property GradientStyle: TGradientStyle read FgradientStyle write SetgradientStyle;
399 property GradientLayout: TGradientLayout read FgradientLayout write SetgradientLayout;
400 property TabOrder;
401 property Border;
402 property MarginTop;
403 property MarginBottom;
404 property MarginLeft;
405 property MarginRight;
406 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
407 property HasBorder;
408 end;
409
410
411
412 //===========================================================================
413 //---- MIRROR FOR A SPLITTER
414 //---- ÇÅÐÊÀËÎ ÄËß ÐÀÇÄÅËÈÒÅËß
415 TKOLSplitter = class( TKOLControl )
416 private
417 FMinSizePrev: Integer;
418 FMinSizeNext: Integer;
419 //FBeveled: Boolean;
420 FEdgeStyle: TEdgeStyle;
421 fNotAvailable: Boolean;
422 procedure SetMinSizeNext(const Value: Integer);
423 procedure SetMinSizePrev(const Value: Integer);
424 //procedure SetBeveled(const Value: Boolean);
425 procedure SetEdgeStyle(const Value: TEdgeStyle);
426 protected
427 function IsCursorDefault: Boolean; override;
428 function SetupParams( const AName, AParent: String ): String; override;
429 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
430 function TypeName: String; override;
431 procedure AssignEvents( SL: TStringList; const AName: String ); override;
432 function BestEventName: String; override;
433 procedure CreateKOLControl(Recreating: boolean); override;
434 function NoDrawFrame: Boolean; override;
435 public
436 constructor Create( AOwner: TComponent ); override;
437 published
438 property Transparent;
439 property MinSizePrev: Integer read FMinSizePrev write SetMinSizePrev;
440 property MinSizeNext: Integer read FMinSizeNext write SetMinSizeNext;
441 property TabOrder;
442 //property beveled: Boolean read FBeveled write SetBeveled;
443 property edgeStyle: TEdgeStyle read FEdgeStyle write SetEdgeStyle;
444 property Caption: Boolean read fNotAvailable;
445 //property CenterOnParent: Boolean read fNotAvailable;
446 property OnSplit;
447 property Brush;
448 end;
449
450
451
452 //===========================================================================
453 //---- MIRROR FOR A GROUPBOX
454 //---- ÇÅÐÊÀËÎ ÄËß ÃÐÓÏÏÛ
455 TKOLGroupBox = class( TKOLControl )
456 private
457 FpopupMenu: TKOLPopupMenu;
458 procedure SetpopupMenu(const Value: TKOLPopupMenu);
459 protected
460 function TabStopByDefault: Boolean; override;
461 procedure FirstCreate; override;
462 function SetupParams( const AName, AParent: String ): String; override;
463 function ClientMargins: TRect; override;
464 function DrawMargins: TRect; override;
465 {$IFDEF _KOLCtrlWrapper_} {YS}
466 procedure CreateKOLControl(Recreating: boolean); override;
467 {$ENDIF}
468 public
469 constructor Create( AOwner: TComponent ); override;
470 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
471 published
472 property Transparent;
473 property TabOrder;
474 property Border;
475 property MarginTop;
476 property MarginBottom;
477 property MarginLeft;
478 property MarginRight;
479 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
480 property TextAlign;
481 property HasBorder;
482 property Brush;
483 end;
484
485
486 //===========================================================================
487 //---- MIRROR FOR A CHECKBOX
488 //---- ÇÅÐÊÀËÎ ÄËß ÔËÀÆÊÀ
489 TKOLCheckBox = class( TKOLControl )
490 private
491 FChecked: Boolean;
492 FpopupMenu: TKOLPopupMenu;
493 FAuto3State: Boolean;
494 procedure SetChecked(const Value: Boolean);
495 procedure SetpopupMenu(const Value: TKOLPopupMenu);
496 procedure SetAuto3State(const Value: Boolean);
497 protected
498 function TabStopByDefault: Boolean; override;
499 procedure FirstCreate; override;
500 function SetupParams( const AName, AParent: String ): String; override;
501 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
502 procedure Paint; override;
503 function WYSIWIGPaintImplemented: Boolean; override;
504 function NoDrawFrame: Boolean; override;
505 procedure CreateKOLControl(Recreating: boolean); override;
506 function TypeName: String; override;
507 public
508 constructor Create( AOwner: TComponent ); override;
509 published
510 property Transparent;
511 property Checked: Boolean read FChecked write SetChecked;
512 property TabStop;
513 property TabOrder;
514 property OnKeyDown;
515 property OnKeyUp;
516 property OnChar;
517 property OnEnter;
518 property OnLeave;
519 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
520 property autoSize;
521 property HasBorder;
522 property Brush;
523 property Auto3State: Boolean read FAuto3State write SetAuto3State;
524 property action;
525 property windowed;
526 property WordWrap; // only for not windowed
527 property Border; // only for not windowed when WordWrap=TRUE
528 end;
529
530
531 //===========================================================================
532 //---- MIRROR FOR A RADIOBOX
533 //---- ÇÅÐÊÀËÎ ÄËß ÐÀÄÈÎ-ÔËÀÆÊÀ
534 TKOLRadioBox = class( TKOLControl )
535 private
536 FChecked: Boolean;
537 FpopupMenu: TKOLPopupMenu;
538 procedure SetChecked(const Value: Boolean);
539 procedure SetpopupMenu(const Value: TKOLPopupMenu);
540 protected
541 function TabStopByDefault: Boolean; override;
542 procedure FirstCreate; override;
543 function SetupParams( const AName, AParent: String ): String; override;
544 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
545 procedure Paint; override;
546 function WYSIWIGPaintImplemented: Boolean; override;
547 function NoDrawFrame: Boolean; override;
548 public
549 constructor Create( AOwner: TComponent ); override;
550 published
551 property Transparent;
552 property Checked: Boolean read FChecked write SetChecked;
553 property TabStop;
554 property TabOrder;
555 property OnKeyDown;
556 property OnKeyUp;
557 property OnChar;
558 property OnEnter;
559 property OnLeave;
560 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
561 property autoSize;
562 property HasBorder;
563 property Brush;
564 property action;
565 property windowed;
566 property WordWrap; // only for not windowed
567 property Border; // only for not windowed when WordWrap=TRUE
568 end;
569
570
571
572
573
574
575
576
577 //===========================================================================
578 //---- MIRROR FOR AN EDITBOX
579 //---- ÇÅÐÊÀËÎ ÄËß ÎÊÍÀ ÂÂÎÄÀ
580 TKOLEditOption = ( {eoNoHScroll, eoNoVScroll,} eoLowercase, {eoMultiline,}
581 eoNoHideSel, eoOemConvert, eoPassword, eoReadonly,
582 eoUpperCase, eoWantTab, eoNumber );
583 TKOLEditOptions = Set of TKOLEditOption;
584
585 TKOLEditBox = class( TKOLControl )
586 private
587 FOptions: TKOLEditOptions;
588 FpopupMenu: TKOLPopupMenu;
589 FEdTransparent: Boolean;
590 procedure SetOptions(const Value: TKOLEditOptions);
591 function GetCaption: String;
592 function GetText: String;
593 procedure SetText(const Value: String);
594 procedure SetpopupMenu(const Value: TKOLPopupMenu);
595 procedure SetEdTransparent(const Value: Boolean);
596 protected
597 function TabStopByDefault: Boolean; override;
598 procedure FirstCreate; override;
599 function SetupParams( const AName, AParent: String ): String; override;
600 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
601 procedure WantTabs( Want: Boolean ); override;
602 function DefaultColor: TColor; override;
603 function BestEventName: String; override;
604 procedure SetupTextAlign(SL: TStrings; const AName: String); override;
605 public
606 constructor Create( AOwner: TComponent ); override;
607 procedure Paint; override;
608 function WYSIWIGPaintImplemented: Boolean; override;
609 function NoDrawFrame: Boolean; override;
610 published
611 property Transparent: Boolean read FEdTransparent write SetEdTransparent;
612 property Text: String read GetText write SetText;
613 property Options: TKOLEditOptions read FOptions write SetOptions;
614 property TabStop;
615 property TabOrder;
616 property OnChange;
617 property OnSelChange;
618 property Caption: String read GetCaption; // redefined as read only to remove from Object Inspector
619 property OnKeyDown;
620 property OnKeyUp;
621 property OnChar;
622 property OnEnter;
623 property OnLeave;
624 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
625 property TextAlign;
626 property autoSize;
627 property HasBorder;
628 property EditTabChar;
629 property Brush;
630 property windowed;
631 end;
632
633
634 //===========================================================================
635 //---- MIRROR FOR A MEMO
636 //---- ÇÅÐÊÀËÎ ÄËß ÌÍÎÃÎÑÒÐÎ×ÍÎÃÎ ÎÊÍÀ ÂÂÎÄÀ
637 TKOLMemoOption = ( eo_NoHScroll, eo_NoVScroll, eo_Lowercase, {eoMultiline,}
638 eo_NoHideSel, eo_OemConvert, eo_Password, eo_Readonly,
639 eo_UpperCase, eo_WantReturn, eo_WantTab );
640 // Character '_' is used to prevent conflict of option names
641 // with the same in TKOLEditOption type. Fortunately, we never
642 // should to use these names in run-time code of the project.
643 //
644 // Ñèìâîë '_' èñïîëüçóåòñÿ, ÷òîáû ïðåäîòâðàòèòü êîíôëèêò ñ
645 // èìåíàìè òàêèõ æå îïöèé äëÿ òèïà TKOLEditOption. Ê ñ÷àñòüþ,
646 // íàì ýòè èìåíà íèêîãäà íå ïîíàäîáÿòñÿ ïðè íàïèñàíèè êîíå÷íîãî
647 // êîäà.
648 TKOLMemoOptions = Set of TKOLMemoOption;
649
650 TKOLMemo = class( TKOLControl )
651 private
652 FOptions: TKOLMemoOptions;
653 FLines: TStrings;
654 FpopupMenu: TKOLPopupMenu;
655 FEdTransparent: Boolean;
656 procedure SetOptions(const Value: TKOLMemoOptions);
657 function GetCaption: String;
658 procedure SetText(const Value: TStrings);
659 function GetText: TStrings;
660 procedure SetpopupMenu(const Value: TKOLPopupMenu);
661 procedure SetEdTransparent(const Value: Boolean);
662 protected
663 function TabStopByDefault: Boolean; override;
664 procedure FirstCreate; override;
665 function SetupParams( const AName, AParent: String ): String; override;
666 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
667 function DefaultColor: TColor; override;
668 function BestEventName: String; override;
669 procedure CreateKOLControl(Recreating: boolean); override;
670 procedure KOLControlRecreated; override;
671 function NoDrawFrame: Boolean; override;
672 procedure Loaded; override;
673 procedure SetTextAlign(const Value: TTextAlign); override;
674 procedure SetupTextAlign(SL: TStrings; const AName: String); override;
675 public
676 constructor Create( AOwner: TComponent ); override;
677 destructor Destroy; override;
678 function TypeName: String; override;
679 procedure WantTabs( Want: Boolean ); override;
680 published
681 property Transparent: Boolean read FEdTransparent write SetEdTransparent;
682 property Text: TStrings read GetText write SetText;
683 property TextAlign;
684 property TabStop;
685 property TabOrder;
686 property Options: TKOLMemoOptions read FOptions write SetOptions;
687 property OnChange;
688 property OnSelChange;
689 property Caption: String read GetCaption; // redefined as read only to remove from Object Inspector
690 property OnKeyDown;
691 property OnKeyUp;
692 property OnChar;
693 property OnEnter;
694 property OnLeave;
695 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
696 property HasBorder;
697 property OnScroll;
698 property EditTabChar;
699 property Brush;
700 end;
701
702
703
704
705 //===========================================================================
706 //---- MIRROR FOR A RICHEDIT
707 //---- ÇÅÐÊÀËÎ ÄËß ÐÅÄÀÊÒÎÐÀ
708 TKOLRichEditVersion = ( ver1, ver3 );
709
710 TKOLRichEdit = class( TKOLControl )
711 private
712 FOptions: TKOLMemoOptions;
713 FLines: TStrings;
714 Fversion: TKOLRichEditVersion;
715 FMaxTextSize: DWORD;
716 FRE_FmtStandard: Boolean;
717 FRE_AutoKeyboard: Boolean;
718 FRE_AutoKeybdSet: Boolean;
719 FRE_DisableOverwriteChange: Boolean;
720 FRE_AutoURLDetect: Boolean;
721 FRE_Transparent: Boolean;
722 FpopupMenu: TKOLPopupMenu;
723 FOLESupport: Boolean;
724 function GetText: TStrings;
725 procedure SetText(const Value: TStrings);
726 procedure SetOptions(const Value: TKOLMemoOptions);
727 function GetCaption: String;
728 procedure Setversion(const Value: TKOLRichEditVersion);
729 procedure SetMaxTextSize(const Value: DWORD);
730 procedure SetRE_FmtStandard(const Value: Boolean);
731 procedure SetRE_AutoKeyboard(const Value: Boolean);
732 procedure SetRE_AutoKeybdSet(const Value: Boolean);
733 procedure SetRE_DisableOverwriteChange(const Value: Boolean);
734 procedure SetRE_AutoURLDetect(const Value: Boolean);
735 procedure SetRE_Transparent(const Value: Boolean);
736 procedure SetpopupMenu(const Value: TKOLPopupMenu);
737 procedure SetOLESupport(const Value: Boolean);
738 protected
739 function TabStopByDefault: Boolean; override;
740 procedure FirstCreate; override;
741 function SetupParams( const AName, AParent: String ): String; override;
742 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
743 function TypeName: String; override;
744 function GenerateTransparentInits: String; override;
745 procedure BeforeFontChange( SL: TStrings; const AName, Prefix: String ); override;
746 function FontPropName: String; override;
747 procedure AfterFontChange( SL: TStrings; const AName, Prefix: String ); override;
748 procedure WantTabs( Want: Boolean ); override;
749 function DefaultColor: TColor; override;
750 function AdditionalUnits: String; override;
751 function BestEventName: String; override;
752 procedure CreateKOLControl(Recreating: boolean); override;
753 procedure KOLControlRecreated; override;
754 procedure Loaded; override;
755 function NoDrawFrame: Boolean; override;
756 public
757 constructor Create( AOwner: TComponent ); override;
758 destructor Destroy; override;
759 published
760 property Transparent read FRE_Transparent write SetRE_Transparent;
761 property RE_Transparent: Boolean read FRE_Transparent write SetRE_Transparent;
762 property Text: TStrings read GetText write SetText;
763 property TabStop;
764 property TabOrder;
765 property Options: TKOLMemoOptions read FOptions write SetOptions;
766 property OnChange;
767 property OnSelChange;
768 property Caption: String read GetCaption; // redefined as read only to remove from Object Inspector
769 property OnKeyDown;
770 property OnKeyUp;
771 property OnChar;
772 property version: TKOLRichEditVersion read Fversion write Setversion;
773 property OnProgress;
774 property OnRE_URLClick;
775 property OnRE_OverURL;
776 property OnRE_InsOvrMode_Change;
777 property RE_DisableOverwriteChange: Boolean read FRE_DisableOverwriteChange write SetRE_DisableOverwriteChange;
778 property MaxTextSize: DWORD read FMaxTextSize write SetMaxTextSize;
779 property RE_FmtStandard: Boolean read FRE_FmtStandard write SetRE_FmtStandard;
780 property RE_AutoKeyboard: Boolean read FRE_AutoKeyboard write SetRE_AutoKeyboard;
781 property RE_AutoKeybdSet: Boolean read FRE_AutoKeybdSet write SetRE_AutoKeybdSet;
782 property RE_AutoURLDetect: Boolean read FRE_AutoURLDetect write SetRE_AutoURLDetect;
783 property OnEnter;
784 property OnLeave;
785 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
786 property HasBorder;
787 property OnScroll;
788 property EditTabChar;
789 property Brush;
790 property OLESupport: Boolean read FOLESupport write SetOLESupport;
791 end;
792
793
794
795
796
797 //===========================================================================
798 //---- MIRROR FOR A LISTBOX
799 //---- ÇÅÐÊÀËÎ ÄËß ÑÏÈÑÊÀ
800 TKOLListboxOption = ( loNoHideScroll, loNoExtendSel, loMultiColumn, loMultiSelect,
801 loNoIntegralHeight, loNoSel, loSort, loTabstops,
802 loNoStrings, loNoData, loOwnerDrawFixed, loOwnerDrawVariable );
803 TKOLListboxOptions = Set of TKOLListboxOption;
804
805 TKOLListBox = class( TKOLControl )
806 private
807 FOptions: TKOLListboxOptions;
808 FItems: TStrings;
809 FCurIndex: Integer;
810 FCount: Integer;
811 FpopupMenu: TKOLPopupMenu;
812 fLBItemHeight: Integer; {+ecm}
813 procedure SetLBItemHeight(const Value: Integer); {+ecm}
814 procedure SetOptions(const Value: TKOLListboxOptions);
815 procedure SetItems(const Value: TStrings);
816 procedure SetCurIndex(const Value: Integer);
817 function GetCaption: String;
818 procedure SetCount(Value: Integer);
819 procedure SetpopupMenu(const Value: TKOLPopupMenu);
820 procedure UpdateItems;
821 protected
822 function TabStopByDefault: Boolean; override;
823 procedure FirstCreate; override;
824 function SetupParams( const AName, AParent: String ): String; override;
825 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
826 procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override;
827 function DefaultColor: TColor; override;
828 procedure CreateKOLControl(Recreating: boolean); override;
829 procedure KOLControlRecreated; override;
830 function NoDrawFrame: Boolean; override;
831 procedure Loaded; override;
832 function GenerateTransparentInits: String; override; {+ecm}
833 public
834 constructor Create( AOwner: TComponent ); override;
835 destructor Destroy; override;
836 published
837 property Transparent;
838 property TabStop;
839 property TabOrder;
840 property Options: TKOLListboxOptions read FOptions write SetOptions;
841 property OnSelChange;
842 property Items: TStrings read FItems write SetItems;
843 property CurIndex: Integer read FCurIndex write SetCurIndex;
844 property OnKeyDown;
845 property OnKeyUp;
846 property OnChar;
847 property Caption: String read GetCaption; // hide Caption in Object Inspector
848 property OnDrawItem;
849 property OnMeasureItem;
850 property Count: Integer read FCount write SetCount;
851 property OnEnter;
852 property OnLeave;
853 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
854 property HasBorder;
855 property OnScroll;
856 property Brush;
857 property LBItemHeight: Integer read fLBItemHeight write SetLBItemHeight; {+ecm}
858 end;
859
860
861
862
863
864
865 //===========================================================================
866 //---- MIRROR FOR A COMBOBOX
867 //---- ÇÅÐÊÀËÎ ÄËß ÂÛÏÀÄÀÞÙÅÃÎ ÑÏÈÑÊÀ
868 TKOLComboOption = ( coReadOnly, coNoHScroll, coAlwaysVScroll, coLowerCase,
869 coNoIntegralHeight, coOemConvert, coSort, coUpperCase,
870 coOwnerDrawFixed, coOwnerDrawVariable, coSimple );
871 TKOLComboOptions = Set of TKOLComboOption;
872
873 TKOLComboBox = class( TKOLControl )
874 private
875 FOptions: TKOLComboOptions;
876 FItems: TStrings;
877 FCurIndex: Integer;
878 FDroppedWidth: Integer;
879 FpopupMenu: TKOLPopupMenu;
880 fCBItemHeight: Integer; {+ecm}
881 procedure SetCBItemHeight(const Value: Integer); {+ecm}
882 procedure SetOptions(const Value: TKOLComboOptions);
883 procedure SetCurIndex(const Value: Integer);
884 procedure SetItems(const Value: TStrings);
885 procedure SetDroppedWidth(const Value: Integer);
886 procedure SetpopupMenu(const Value: TKOLPopupMenu);
887 protected
888 function TabStopByDefault: Boolean; override;
889 procedure FirstCreate; override;
890 function SetupParams( const AName, AParent: String ): String; override;
891 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
892 function DefaultColor: TColor; override;
893 function DefaultInitialColor: TColor; override;
894 procedure Paint; override;
895 function WYSIWIGPaintImplemented: Boolean; override;
896 function NoDrawFrame: Boolean; override;
897 function AutoHeight( Canvas: graphics.TCanvas ): Integer; override;
898 function AutoSizeRunTime: Boolean; override;
899 function GenerateTransparentInits: String; override; {+ecm}
900 public
901 constructor Create( AOwner: TComponent ); override;
902 destructor Destroy; override;
903 published
904 property Transparent;
905 property TabStop;
906 property TabOrder;
907 property Options: TKOLComboOptions read FOptions write SetOptions;
908 property OnChange;
909 property OnSelChange;
910 property OnDropDown;
911 property OnCloseUp;
912 property Items: TStrings read FItems write SetItems;
913 property CurIndex: Integer read FCurIndex write SetCurIndex;
914 property DroppedWidth: Integer read FDroppedWidth write SetDroppedWidth;
915 property OnKeyDown;
916 property OnKeyUp;
917 property OnChar;
918 property OnMeasureItem;
919 property OnDrawItem;
920 property OnEnter;
921 property OnLeave;
922 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
923 property autoSize;
924 property Brush;
925 property CBItemHeight: Integer read fCBItemHeight write SetCBItemHeight; {+ecm}
926 end;
927
928
929
930
931 //===========================================================================
932 //---- MIRROR FOR A PAINTBOX
933 //---- ÇÅÐÊÀËÎ ÄËß ÌÎËÜÁÅÐÒÀ
934 TKOLPaintBox = class( TKOLControl )
935 private
936 FpopupMenu: TKOLPopupMenu;
937 fNotAvailable: Boolean;
938 procedure SetpopupMenu(const Value: TKOLPopupMenu);
939 protected
940 function SetupParams( const AName, AParent: String ): String; override;
941 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
942 function BestEventName: String; override;
943 public
944 constructor Create( AOwner: TComponent ); override;
945 published
946 property Transparent;
947 property OnPaint;
948 property Border;
949 property MarginTop;
950 property MarginBottom;
951 property MarginLeft;
952 property MarginRight;
953 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
954 property Caption: Boolean read fNotAvailable;
955 property windowed;
956 end;
957
958
959
960 //===========================================================================
961 //---- MIRROR FOR A IMAGESHOW
962 //---- ÇÅÐÊÀËÎ ÄËß ÊÀÐÒÈÍÊÈ
963 TKOLImageShow = class( TKOLControl )
964 private
965 FCurIndex: Integer;
966 FImageListNormal: TKOLImageList;
967 FpopupMenu: TKOLPopupMenu;
968 fNotAvailable: Boolean;
969 FHasBorder: Boolean;
970 fImgShwAutoSize: Boolean;
971 procedure SetCurIndex(const Value: Integer);
972 procedure SetImageListNormal(const Value: TKOLImageList);
973 procedure SetpopupMenu(const Value: TKOLPopupMenu);
974 procedure SetImgShwAutoSize(const Value: Boolean);
975 protected
976 function SetupParams( const AName, AParent: String ): String; override;
977 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
978 procedure DoAutoSize;
979 procedure SetHasBorder(const Value: Boolean); override;
980 procedure Paint; override;
981 function WYSIWIGPaintImplemented: Boolean; override;
982 function NoDrawFrame: Boolean; override;
983 public
984 constructor Create( AOwner: TComponent ); override;
985 destructor Destroy; override;
986 procedure NotifyLinkedComponent( Sender: TObject; Operation: TNotifyOperation ); override;
987 procedure SetBounds( aLeft, aTop, aWidth, aHeight: Integer ); override;
988 published
989 property ImageListNormal: TKOLImageList read FImageListNormal write SetImageListNormal;
990 property CurIndex: Integer read FCurIndex write SetCurIndex;
991 property Transparent;
992 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
993 property Caption: Boolean read fNotAvailable;
994 property HasBorder; //: Boolean read FHasBorder write SetHasBorder;
995 property autoSize: Boolean read fImgShwAutoSize write SetImgShwAutoSize;
996 property Brush;
997 end;
998
999 //===========================================================================
1000 //---- MIRROR FOR A PROGRESSBAR
1001 //---- ÇÅÐÊÀËÎ ÄËß ËÈÍÅÉÊÈ ÏÐÎÃÐÅÑÑÀ
1002 TKOLProgressBar = class( TKOLControl )
1003 private
1004 FVertical: Boolean;
1005 FSmooth: Boolean;
1006 //FProgressBkColor: TColor;
1007 FProgressColor: TColor;
1008 FMaxProgress: Integer;
1009 FProgress: Integer;
1010 fNotAvailable: Boolean;
1011 FpopupMenu: TKOLPopupMenu;
1012 procedure SetSmooth(const Value: Boolean);
1013 procedure SetVertical(const Value: Boolean);
1014 //procedure SetProgressBkColor(const Value: TColor);
1015 procedure SetProgressColor(const Value: TColor);
1016 procedure SetMaxProgress(const Value: Integer);
1017 procedure SetProgress(const Value: Integer);
1018 procedure SetpopupMenu(const Value: TKOLPopupMenu);
1019 function GetColor: TColor;
1020 procedure SetColor(const Value: TColor);
1021 protected
1022 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
1023 function SetupParams( const AName, AParent: String ): String; override;
1024 function TypeName: String; override;
1025 procedure CreateKOLControl(Recreating: boolean); override;
1026 procedure KOLControlRecreated; override;
1027 function NoDrawFrame: Boolean; override;
1028 public
1029 constructor Create( AOwner: TComponent ); override;
1030 published
1031 property Transparent;
1032 property Vertical: Boolean read FVertical write SetVertical;
1033 property Smooth: Boolean read FSmooth write SetSmooth;
1034 property ProgressColor: TColor read FProgressColor write SetProgressColor;
1035 property ProgressBkColor: TColor read GetColor write SetColor;
1036 property Progress: Integer read FProgress write SetProgress;
1037 property MaxProgress: Integer read FMaxProgress write SetMaxProgress;
1038 property Caption: Boolean read fNotAvailable;
1039 property OnMouseDblClk: Boolean read fNotAvailable;
1040 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
1041 property Brush;
1042 end;
1043
1044
1045 //===========================================================================
1046 //---- MIRROR FOR A LISTVIEW
1047 //---- ÇÅÐÊÀËÎ ÄËß ÏÐÎÑÌÎÒÐÀ ÑÏÈÑÊÀ / ÒÀÁËÈÖÛ
1048 TKOLListViewStyle = ( lvsIcon, lvsSmallIcon, lvsList, lvsDetail, lvsDetailNoHeader );
1049
1050 TKOLListViewOption = ( lvoIconLeft, lvoAutoArrange, lvoButton, lvoEditLabel,
1051 lvoNoLabelWrap, lvoNoScroll, lvoNoSortHeader, lvoHideSel, lvoMultiselect,
1052 lvoSortAscending, lvoSortDescending, lvoGridLines, lvoSubItemImages,
1053 lvoCheckBoxes, lvoTrackSelect, lvoHeaderDragDrop, lvoRowSelect, lvoOneClickActivate,
1054 lvoTwoClickActivate, lvoFlatsb, lvoRegional, lvoInfoTip, lvoUnderlineHot,
1055 lvoMultiWorkares, lvoOwnerData, lvoOwnerDrawFixed );
1056 TKOLListViewOptions = Set of TKOLListViewOption;
1057
1058 TKOLListViewColWidthType = ( lvcwtCustom, lvcwtAutosize, lvcwtAutoSizeCaption );
1059
1060 TKOLListView = class;
1061
1062 TKOLListViewColumn = class( TComponent )
1063 private
1064 FListView: TKOLListView;
1065 FLVColImage: Integer;
1066 FLVColOrder: Integer;
1067 FWidth: Integer;
1068 FCaption: String;
1069 FWidthType: TKOLListViewColWidthType;
1070 FTextAlign: TTextAlign;
1071 FLVColRightImg: Boolean;
1072 procedure SetCaption(const Value: String);
1073 procedure SetLVColImage(const Value: Integer);
1074 procedure SetLVColOrder(const Value: Integer);
1075 procedure SetTextAlign(const Value: TTextAlign);
1076 procedure SetWidth(const Value: Integer);
1077 procedure SetWidthType(const Value: TKOLListViewColWidthType);
1078 procedure Change;
1079 procedure SetLVColRightImg(const Value: Boolean);
1080 protected
1081 procedure SetName( const AName: TComponentName ); override;
1082 procedure DefProps( const Prefix: String; Filer: TFiler );
1083 procedure LoadName( Reader: TReader );
1084 procedure SaveName( Writer: TWriter );
1085 procedure LoadCaption( Reader: TReader );
1086 procedure SaveCaption( Writer: TWriter );
1087 procedure LoadTextAlign( Reader: TReader );
1088 procedure SaveTextAlign( Writer: TWriter );
1089 procedure LoadWidth( Reader: TReader );
1090 procedure SaveWidth( Writer: TWriter );
1091 procedure LoadWidthType( Reader: TReader );
1092 procedure SaveWidthType( Writer: TWriter );
1093 procedure LoadLVColImage( Reader: TReader );
1094 procedure SaveLVColImage( Writer: TWriter );
1095 procedure LoadLVColOrder( Reader: TReader );
1096 procedure SaveLVColOrder( Writer: TWriter );
1097 procedure LoadLVColRightImg( Reader: TReader );
1098 procedure SaveLVColRightImg( Writer: TWriter );
1099 public
1100 constructor Create( AOwner: TComponent ); override;
1101 destructor Destroy; override;
1102 published
1103 property Caption: String read FCaption write SetCaption;
1104 property TextAlign: TTextAlign read FTextAlign write SetTextAlign;
1105 property Width: Integer read FWidth write SetWidth;
1106 property WidthType: TKOLListViewColWidthType read FWidthType write SetWidthType;
1107 property LVColImage: Integer read FLVColImage write SetLVColImage;
1108 property LVColRightImg: Boolean read FLVColRightImg write SetLVColRightImg;
1109 property LVColOrder: Integer read FLVColOrder write SetLVColOrder;
1110 end;
1111
1112 TKOLListView = class( TKOLControl )
1113 private
1114 FOptions: TKOLListViewOptions;
1115 FStyle: TKOLListViewStyle;
1116 FImageListNormal: TKOLImageList;
1117 FImageListSmall: TKOLImageList;
1118 FImageListState: TKOLImageList;
1119 FCurIndex: Integer;
1120 FLVCount: Integer;
1121 FpopupMenu: TKOLPopupMenu;
1122 FLVBkColor: TColor;
1123 FLVTextBkColor: TColor;
1124 FOnLVDelete: TOnLVDelete;
1125 FGenerateColIdxConst: Boolean;
1126 FOnLVCustomDraw: TOnLVCustomDraw;
1127 {$IFNDEF _D2}
1128 FOnLVDataW: TOnLVDataW;
1129 {$ENDIF _D2}
1130 fLVItemHeight: Integer;
1131 procedure SetOptions(const Value: TKOLListViewOptions);
1132 procedure SetStyle(const Value: TKOLListViewStyle);
1133 procedure SetImageListNormal(const Value: TKOLImageList);
1134 procedure SetImageListSmall(const Value: TKOLImageList);
1135 procedure SetImageListState(const Value: TKOLImageList);
1136 function GetCaption: String;
1137 procedure SetLVCount(Value: Integer);
1138 procedure SetpopupMenu(const Value: TKOLPopupMenu);
1139 procedure SetLVTextBkColor(const Value: TColor);
1140 function GetColor: TColor;
1141 procedure SetColor(const Value: TColor);
1142 procedure SetOnLVDelete(const Value: TOnLVDelete);
1143 function GetColumns: String;
1144 procedure SetColumns(const Value: String);
1145 procedure SetGenerateColIdxConst(const Value: Boolean);
1146 procedure SetOnLVCustomDraw(const Value: TOnLVCustomDraw);
1147 procedure UpdateColumns;
1148 {$IFNDEF _D2}
1149 procedure SetOnLVDataW(const Value: TOnLVDataW); {YS}
1150 {$ENDIF _D2}
1151 procedure SetLVItemHeight(const Value: Integer);
1152 protected
1153 FCols: TList;
1154 FColCount: Integer;
1155 function TabStopByDefault: Boolean; override;
1156 function SetupParams( const AName, AParent: String ): String; override;
1157 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
1158 procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override;
1159 function DefaultColor: TColor; override;
1160 procedure AssignEvents( SL: TStringList; const AName: String ); override;
1161 procedure DefineProperties( Filer: TFiler ); override;
1162 procedure LoadColCount( Reader: TReader );
1163 procedure SaveColCount( Writer: TWriter );
1164 procedure DoGenerateConstants( SL: TStringList ); override;
1165 procedure Loaded; override; {YS}
1166 function NoDrawFrame: Boolean; override;
1167 procedure CreateKOLControl(Recreating: boolean); override;
1168 procedure KOLControlRecreated; override;
1169 function GetDefaultControlFont: HFONT; override;
1170 function GenerateTransparentInits: String; override;
1171 public
1172 ActiveDesign: TfmLVColumnsEditor;
1173 constructor Create( AOwner: TComponent ); override;
1174 procedure NotifyLinkedComponent( Sender: TObject; Operation: TNotifyOperation ); override;
1175 destructor Destroy; override;
1176 property Cols: TList read FCols;
1177 function HasOrderedColumns: Boolean;
1178 procedure Invalidate; override; {YS}
1179 published
1180 property Transparent;
1181 property Style: TKOLListViewStyle read FStyle write SetStyle;
1182 property Options: TKOLListViewOptions read FOptions write SetOptions;
1183 property ImageListSmall: TKOLImageList read FImageListSmall write SetImageListSmall;
1184 property ImageListNormal: TKOLImageList read FImageListNormal write SetImageListNormal;
1185 property ImageListState: TKOLImageList read FImageListState write SetImageListState;
1186 //property CurIndex: Integer read FCurIndex write SetCurIndex;
1187 property OnChange;
1188 property OnKeyDown;
1189 property OnKeyUp;
1190 property OnChar;
1191 property Caption: String read GetCaption; // hide Caption in Object Inspector
1192 property OnDeleteLVItem;
1193 property OnDeleteAllLVItems;
1194 property OnLVData;
1195 property LVCount: Integer read FLVCount write SetLVCount;
1196 property LVTextBkColor: TColor read FLVTextBkColor write SetLVTextBkColor;
1197 property LVBkColor: TColor read GetColor write SetColor;
1198 property LVItemHeight: Integer read fLVItemHeight write SetLVItemHeight;
1199 property OnCompareLVItems;
1200 property OnEndEditLVItem;
1201 property OnColumnClick;
1202 property OnLVStateChange;
1203 property OnDrawItem;
1204 property OnLVCustomDraw: TOnLVCustomDraw read FOnLVCustomDraw write SetOnLVCustomDraw;
1205 property OnEnter;
1206 property OnLeave;
1207 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
1208 property OnMeasureItem;
1209 property HasBorder;
1210 property OnScroll;
1211 property TabStop;
1212 property OnLVDelete: TOnLVDelete read FOnLVDelete write SetOnLVDelete;
1213 property Columns: String read GetColumns write SetColumns stored FALSE;
1214 property generateConstants: Boolean read FGenerateColIdxConst write SetGenerateColIdxConst;
1215 property Brush;
1216 property Unicode;
1217 {$IFNDEF _D2}
1218 property OnLVDataW: TOnLVDataW read FOnLVDataW write SetOnLVDataW;
1219 {$ENDIF _D2}
1220 end;
1221
1222 TKOLLVColumnsEditor = class( TComponentEditor )
1223 private
1224 protected
1225 public
1226 procedure Edit; override;
1227 procedure ExecuteVerb(Index: Integer); override;
1228 function GetVerb(Index: Integer): string; override;
1229 function GetVerbCount: Integer; override;
1230 end;
1231
1232 TKOLLVColumnsPropEditor = class( TStringProperty )
1233 private
1234 protected
1235 public
1236 function GetAttributes: TPropertyAttributes; override;
1237 procedure Edit; override;
1238 end;
1239
1240
1241
1242 //===========================================================================
1243 //---- MIRROR FOR A TREEVIEW
1244 //---- ÇÅÐÊÀËÎ ÄËß ÏÐÎÑÌÎÒÐÀ ÄÅÐÅÂÀ
1245 TKOLTreeViewOption = ( tvoNoLines, tvoLinesRoot, tvoNoButtons, tvoEditLabels, tvoHideSel,
1246 tvoDragDrop, tvoNoTooltips, tvoCheckBoxes, tvoTrackSelect,
1247 tvoSingleExpand, tvoInfoTip, tvoFullRowSelect, tvoNoScroll,
1248 tvoNonEvenHeight );
1249 TKOLTreeViewOptions = Set of TKOLTreeViewOption;
1250
1251 TKOLTreeView = class( TKOLControl )
1252 private
1253 FOptions: TKOLTreeViewOptions;
1254 FCurIndex: Integer;
1255 FImageListNormal: TKOLImageList;
1256 FImageListState: TKOLImageList;
1257 FTVRightClickSelect: Boolean;
1258 FpopupMenu: TKOLPopupMenu;
1259 FTVIndent: Integer;
1260 procedure SetOptions(const Value: TKOLTreeViewOptions);
1261 procedure SetCurIndex(const Value: Integer);
1262 procedure SetImageListNormal(const Value: TKOLImageList);
1263 procedure SetImageListState(const Value: TKOLImageList);
1264 procedure SetTVRightClickSelect(const Value: Boolean);
1265 procedure SetpopupMenu(const Value: TKOLPopupMenu);
1266 procedure SetTVIndent(const Value: Integer);
1267 protected
1268 function TabStopByDefault: Boolean; override;
1269 function SetupParams( const AName, AParent: String ): String; override;
1270 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
1271 function DefaultColor: TColor; override;
1272 procedure CreateKOLControl(Recreating: boolean); override;
1273 function NoDrawFrame: Boolean; override;
1274 public
1275 constructor Create( AOwner: TComponent ); override;
1276 procedure NotifyLinkedComponent( Sender: TObject; Operation: TNotifyOperation ); override;
1277 destructor Destroy; override;
1278 published
1279 property Transparent;
1280 property Options: TKOLTreeViewOptions read FOptions write SetOptions;
1281 property ImageListNormal: TKOLImageList read FImageListNormal write SetImageListNormal;
1282 property ImageListState: TKOLImageList read FImageListState write SetImageListState;
1283 property CurIndex: Integer read FCurIndex write SetCurIndex;
1284 property TVRightClickSelect: Boolean read FTVRightClickSelect write SetTVRightClickSelect;
1285 property OnChange;
1286 property OnSelChange;
1287 property OnKeyDown;
1288 property OnKeyUp;
1289 property OnChar;
1290 property OnTVBeginDrag;
1291 property OnTVBeginEdit;
1292 property OnTVEndEdit;
1293 property OnTVExpanding;
1294 property OnTVExpanded;
1295 property OnTVDelete;
1296 property OnTVSelChanging;
1297 property OnEnter;
1298 property OnLeave;
1299 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
1300 property TVIndent: Integer read FTVIndent write SetTVIndent;
1301 property HasBorder;
1302 property OnScroll;
1303 property TabStop;
1304 property Brush;
1305 property Unicode;
1306 end;
1307
1308 //===========================================================================
1309 //---- MIRROR FOR A TOOLBAR
1310 //---- ÇÅÐÊÀËÎ ÄËß ËÈÍÅÉÊÈ ÊÍÎÏÎÊ
1311 TKOLToolbar = class;
1312
1313 TSystemToolbarImage = ( stiCustom, stdCUT, stdCOPY, stdPASTE, stdUNDO,
1314 stdREDO, stdDELETE, stdFILENEW, stdFILEOPEN,
1315 stdFILESAVE, stdPRINTPRE, stdPROPERTIES,
1316 stdHELP, stdFIND, stdREPLACE, stdPRINT,
1317
1318 viewLARGEICONS, viewSMALLICONS, viewLIST,
1319 viewDETAILS, viewSORTNAME, viewSORTSIZE,
1320 viewSORTDATE, viewSORTTYPE, viewPARENTFOLDER,
1321 viewNETCONNECT, viewNETDISCONNECT, viewNEWFOLDER,
1322 viewVIEWMENU,
1323
1324 histBACK, histFORWARD, histFAVORITES,
1325 histADDTOFAVORITES, histVIEWTREE );
1326
1327 TKOLToolbarButton = class( TComponent )
1328 private
1329 FToolbar: TKOLToolbar;
1330 Fenabled: Boolean;
1331 Fseparator: Boolean;
1332 Fvisible: Boolean;
1333 Fdropdown: Boolean;
1334 Fcaption: String;
1335 Ftooltip: String;
1336 FonClick: TOnToolbarButtonClick;
1337 fOnClickMethodName: String;
1338 Fpicture: TPicture;
1339 Fchecked: Boolean;
1340 fNotAvailable: Boolean;
1341 Fsysimg: TSystemToolbarImage;
1342 FradioGroup: Integer;
1343 FimgIndex: Integer;
1344 Faction: TKOLAction;
1345 procedure Setcaption(const Value: String);
1346 procedure Setdropdown(const Value: Boolean);
1347 procedure Setenabled(const Value: Boolean);
1348 procedure SetonClick(const Value: TOnToolbarButtonClick);
1349 procedure Setpicture(Value: TPicture);
1350 procedure Setseparator(const Value: Boolean);
1351 procedure Settooltip(const Value: String);
1352 procedure Setvisible(const Value: Boolean);
1353 procedure Setchecked(const Value: Boolean);
1354 procedure Setsysimg(const Value: TSystemToolbarImage);
1355 procedure SetradioGroup(const Value: Integer);
1356 procedure SetimgIndex(const Value: Integer);
1357 procedure Setaction(const Value: TKOLAction);
1358 protected
1359 procedure Change;
1360 procedure SetName( const NewName: TComponentName ); override;
1361 procedure DefProps( const Prefix: String; Filer: Tfiler );
1362 procedure LoadName( Reader: TReader );
1363 procedure SaveName( Writer: TWriter );
1364 procedure LoadProps( Reader: TReader );
1365 procedure SaveProps( Writer: TWriter );
1366 procedure LoadCaption( Reader: TReader );
1367 procedure SaveCaption( Writer: TWriter );
1368 procedure LoadChecked( Reader: TReader );
1369 procedure SaveChecked( Writer: TWriter );
1370 procedure LoadDropDown( Reader: TReader );
1371 procedure SaveDropDown( Writer: TWriter );
1372 procedure LoadEnabled( Reader: TReader );
1373 procedure SaveEnabled( Writer: TWriter );
1374 procedure LoadSeparator( Reader: TReader );
1375 procedure SaveSeparator( Writer: TWriter );
1376 procedure LoadTooltip( Reader: TReader );
1377 procedure SaveTooltip( Writer: TWriter );
1378 procedure LoadVisible( Reader: TReader );
1379 procedure SaveVisible( Writer: TWriter );
1380 procedure LoadOnClick( Reader: TReader );
1381 procedure SaveOnClick( Writer: TWriter );
1382 procedure LoadPicture( Reader: TReader );
1383 procedure SavePicture( Writer: TWriter );
1384 procedure LoadSysImg( Reader: TReader );
1385 procedure SaveSysImg( Writer: TWriter );
1386 procedure LoadRadioGroup( Reader: TReader );
1387 procedure SaveRadioGroup( Writer: TWriter );
1388 procedure LoadImgIndex( Reader: TReader );
1389 procedure SaveImgIndex( Writer: TWriter );
1390 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
1391 public
1392 constructor Create( AOwner: TComponent ); override;
1393 destructor Destroy; override;
1394 function HasPicture: Boolean;
1395 property ToolbarComponent: TKOLToolbar read FToolbar;
1396 published
1397 property separator: Boolean read Fseparator write Setseparator;
1398 property dropdown: Boolean read Fdropdown write Setdropdown;
1399 property checked: Boolean read Fchecked write Setchecked;
1400 property radioGroup: Integer read FradioGroup write SetradioGroup;
1401 property picture: TPicture read Fpicture write Setpicture;
1402 property sysimg: TSystemToolbarImage read Fsysimg write Setsysimg;
1403 property imgIndex: Integer read FimgIndex write SetimgIndex;
1404 property visible: Boolean read Fvisible write Setvisible;
1405 property enabled: Boolean read Fenabled write Setenabled;
1406 property onClick: TOnToolbarButtonClick read FonClick write SetonClick;
1407 property caption: String read Fcaption write Setcaption;
1408 property tooltip: String read Ftooltip write Settooltip;
1409 property Tag: Boolean read fNotAvailable;
1410 property action: TKOLAction read Faction write Setaction;
1411 end;
1412
1413 TKOLToolbar = class( TKOLControl )
1414 private
1415 FOptions: TToolbarOptions;
1416 Fbitmap: TBitmap;
1417 Fbuttons: String;
1418 FnoTextLabels: Boolean;
1419 Ftooltips: TStrings;
1420 FshowTooltips: Boolean;
1421 FmapBitmapColors: Boolean;
1422 FpopupMenu: TKOLPopupMenu;
1423 fNotAvailable: Boolean;
1424 FTimer: TTimer;
1425 FItems: TList; // of TKOLToolbarButton
1426 FButtonCount: Integer;
1427 FStandardImagesLarge: Boolean;
1428 FgenerateConstants: Boolean;
1429 FbuttonMinWidth: Integer;
1430 FbuttonMaxWidth: Integer;
1431 FHeightAuto: Boolean;
1432 FimageListNormal: TKOLImageList;
1433 FimageListDisabled: TKOLImageList;
1434 FimageListHot: TKOLImageList;
1435 FFixFlatXP: Boolean;
1436 FTBButtonsWidth: Integer;
1437 FgenerateVariables: Boolean;
1438 procedure SetOptions(const Value: TToolbarOptions);
1439 procedure Setbitmap(const Value: TBitmap);
1440 procedure SetnoTextLabels(const Value: Boolean);
1441 procedure Settooltips(const Value: TStrings);
1442 procedure SetshowTooltips(const Value: Boolean);
1443 procedure SetmapBitmapColors(const Value: Boolean);
1444 procedure SetpopupMenu(const Value: TKOLPopupMenu);
1445 procedure SetBtnCount_Dummy(const Value: Integer);
1446 function MaxBtnImgHeight: Integer;
1447 function MaxBtnImgWidth: Integer;
1448 procedure SetStandardImagesLarge(const Value: Boolean);
1449 procedure SetgenerateConstants(const Value: Boolean);
1450 procedure SetbuttonMaxWidth(const Value: Integer);
1451 procedure SetbuttonMinWidth(const Value: Integer);
1452 function GetButtons: String;
1453 procedure SetAutoHeight(const Value: Boolean);
1454 procedure UpdateButtons;
1455 procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
1456 procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
1457 procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
1458 procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
1459 procedure SetimageList(const Value: TKOLImageList);
1460 procedure SetDisabledimageList(const Value: TKOLImageList);
1461 procedure SetHotimageList(const Value: TKOLImageList);
1462 procedure SetFixFlatXP(const Value: Boolean);
1463 procedure SetTBButtonsWidth(const Value: Integer);
1464 procedure SetgenerateVariables(const Value: Boolean);
1465 protected
1466 FResBmpID: Integer;
1467 fNewVersion: Boolean;
1468 FBmpTranColor: TColor;
1469 FBmpDesign: HBitmap;
1470 procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
1471 function SetupParams( const AName, AParent: String ): String; override;
1472 procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override;
1473 procedure DefineProperties(Filer: TFiler); override;
1474 procedure ReadNewVersion( Reader: TReader );
1475 procedure WriteNewVersion( Writer: TWriter );
1476 procedure LoadButtonCount( R: TReader );
1477 procedure SaveButtonCount( W: TWriter );
1478 procedure Loaded; override;
1479 function StandardImagesUsed: Integer;
1480 function PicturedButtonsCount: Integer;
1481 function ImagedButtonsCount: Integer;
1482 function NoMorePicturedButtonsFrom( Idx: Integer ): Boolean;
1483 function AllPicturedButtonsAreLeading: Boolean;
1484 function LastBtnHasPicture: Boolean;
1485 procedure CreateKOLControl(Recreating: boolean); override;
1486 procedure KOLControlRecreated; override;
1487 function NoDrawFrame: Boolean; override;
1488 procedure SetMargin(const Value: Integer); override;
1489 procedure Paint; override;
1490 function GetDefaultControlFont: HFONT; override;
1491 function ImageListsUsed: Boolean;
1492 public
1493 function Generate_SetSize: String; override;
1494 public
1495 ActiveDesign: TfmToolbarEditor;
1496 constructor Create( AOwner: TComponent ); override;
1497 destructor Destroy; override;
1498 procedure Change; override;
1499 procedure Tick( Sender: TObject );
1500 property Items: TList read FItems;
1501 procedure Items2buttons;
1502 procedure DoGenerateConstants( SL: TStringList ); override;
1503 procedure NotifyLinkedComponent( Sender: TObject; Operation: TNotifyOperation ); override;
1504 function MaxImgIndex: Integer;
1505 published
1506 property Transparent;
1507 property Options: TToolbarOptions read FOptions write SetOptions;
1508 property bitmap: TBitmap read Fbitmap write Setbitmap;
1509 property buttons: String read GetButtons write Fbuttons;
1510 property OnTBDropDown;
1511 property OnClick;
1512 property noTextLabels: Boolean read FnoTextLabels write SetnoTextLabels;
1513 property tooltips: TStrings read Ftooltips write Settooltips;
1514 property showTooltips: Boolean read FshowTooltips write SetshowTooltips;
1515 property mapBitmapColors: Boolean read FmapBitmapColors write SetmapBitmapColors;
1516 property Border;
1517 property MarginTop;
1518 property MarginBottom;
1519 property MarginLeft;
1520 property MarginRight;
1521 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
1522 property Caption: Boolean read fNotAvailable;
1523 property HasBorder;
1524
1525 property ButtonCount: Integer read FButtonCount write SetBtnCount_Dummy
1526 stored FALSE;
1527 procedure buttons2Items;
1528 procedure bitmap2ItemPictures( AnyWay: Boolean );
1529 procedure AssembleBitmap;
1530 procedure AssembleTooltips;
1531 property StandardImagesLarge: Boolean read FStandardImagesLarge write SetStandardImagesLarge;
1532 property generateConstants: Boolean read FgenerateConstants write SetgenerateConstants;
1533 property generateVariables: Boolean read FgenerateVariables write SetgenerateVariables;
1534 property TBButtonsMinWidth: Integer read FbuttonMinWidth write SetbuttonMinWidth;
1535 property TBButtonsMaxWidth: Integer read FbuttonMaxWidth write SetbuttonMaxWidth;
1536 property TBButtonsWidth: Integer read FTBButtonsWidth write SetTBButtonsWidth;
1537 property HeightAuto: Boolean read FHeightAuto write SetAutoHeight;
1538 property Brush;
1539 property Ctl3D;
1540
1541 property imageListNormal: TKOLImageList read FimageListNormal write SetimageList;
1542 property imageListDisabled: TKOLImageList read FimageListDisabled write SetDisabledimageList;
1543 property imageListHot: TKOLImageList read FimageListHot write SetHotimageList;
1544
1545 property FixFlatXP: Boolean read FFixFlatXP write SetFixFlatXP;
1546 // If TRUE (default) then some styles are changed in case of XP on start.
1547 // This useful (and necessary) only if XP Manifest is used in the application
1548 // in other case this property can be set to FALSE to make code smaller
1549 // and to prevent "heavy" property TRUE from usage.
1550 // This property has effect only for toolbars with tboFlat style though.
1551 end;
1552
1553 TKOLToolbarButtonsEditor = class( TStringProperty )
1554 private
1555 protected
1556 public
1557 function GetAttributes: TPropertyAttributes; override;
1558 procedure Edit; override;
1559 end;
1560
1561 TKOLToolbarEditor = class( TComponentEditor )
1562 private
1563 protected
1564 public
1565 procedure Edit; override;
1566 procedure ExecuteVerb(Index: Integer); override;
1567 function GetVerb(Index: Integer): string; override;
1568 function GetVerbCount: Integer; override;
1569 end;
1570
1571 TKOLToolButtonOnClickPropEditor = class( TMethodProperty )
1572 private
1573 FResetting: Boolean;
1574 protected
1575 public
1576 function GetValue: string; override;
1577 procedure SetValue(const AValue: string); override;
1578 end;
1579
1580
1581 //===========================================================================
1582 //---- MIRROR FOR A DATE TIME PICKER
1583 //---- ÇÅÐÊÀËÎ ÄËß ÂÂÎÄÀ ÄÀÒÛ È ÂÐÅÌÅÍÈ
1584 TKOLDateTimePicker = class( TKOLControl )
1585 private
1586 FOnDTPUserString: TDTParseInputEvent;
1587 FOptions: TDateTimePickerOptions;
1588 FFormat: String;
1589 procedure SetOnDTPUserString(const Value: TDTParseInputEvent);
1590 procedure SetOptions(const Value: TDateTimePickerOptions);
1591 procedure SetFormat(const Value: String);
1592 protected
1593 function SetupParams( const AName, AParent: String ): String; override;
1594 function GenerateTransparentInits: String; override;
1595 procedure SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); override;
1596 procedure AssignEvents( SL: TStringList; const AName: String ); override;
1597 public
1598 constructor Create( AOwner: TComponent ); override;
1599 published
1600 function TabStopByDefault: Boolean; override;
1601 property OnDTPUserString: TDTParseInputEvent read FOnDTPUserString write SetOnDTPUserString;
1602 property Options: TDateTimePickerOptions read FOptions write SetOptions;
1603 property Format: String read FFormat write SetFormat;
1604 property TabStop;
1605 end;
1606
1607
1608
1609 //===========================================================================
1610 //---- MIRROR FOR A TAB CONTROL
1611 //---- ÇÅÐÊÀËÎ ÄËß ÒÀÁÓËÈÐÎÂÀÍÍÎÃÎ ÁËÎÊÍÎÒÀ
1612 TKOLTabPage = TKOLPanel;
1613
1614 TKOLTabControl = class( TKOLControl )
1615 private
1616 FOptions: TTabControlOptions;
1617 FImageList: TKOLImageList;
1618 FTabs: TList;
1619 FImageList1stIdx: Integer;
1620 FedgeType: TEdgeStyle;
1621 FpopupMenu: TKOLPopupMenu; // of TRect
1622 FCurPage: TKOLPanel;
1623 FgenerateConstants: Boolean;
1624 procedure SetOptions(const Value: TTabControlOptions);
1625 procedure SetImageList(const Value: TKOLImageList);
1626 function GetPages(Idx: Integer): TKOLTabPage;
1627 procedure SetCount(const Value: Integer);
1628 function GetCount: Integer;
1629 procedure AdjustPages;
1630 function GetCurIndex: Integer;
1631 procedure SetCurIndex(const Value: Integer);
1632 procedure AttemptToChangePageBounds( Sender: TObject; var NewBounds: TRect );
1633 procedure SetImageList1stIdx(const Value: Integer);
1634 procedure SetedgeType(const Value: TEdgeStyle);
1635 procedure SetpopupMenu(const Value: TKOLPopupMenu);
1636 procedure SetgenerateConstants(const Value: Boolean);
1637 protected
1638 fDestroyingTabControl: Boolean;
1639 FAdjustingPages: Boolean;
1640 function TabStopByDefault: Boolean; override;
1641 function SetupParams( const AName, AParent: String ): String; override;
1642 procedure SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); override;
1643 procedure SetupLast(SL: TStringList; const AName, AParent, Prefix: String); override;
1644 procedure SchematicPaint;
1645 procedure Paint; override;
1646 function WYSIWIGPaintImplemented: Boolean; override;
1647 function NoDrawFrame: Boolean; override;
1648 function GetCurrentPage: TKOLTabPage;
1649 procedure DoGenerateConstants( SL: TStringList ); override;
1650 public
1651 constructor Create( AOwner: TComponent ); override;
1652 destructor Destroy; override;
1653 property Pages[ Idx: Integer ]: TKOLTabPage read GetPages;
1654 procedure SetBounds( aLeft, aTop, aWidth, aHeight: Integer ); override;
1655 published
1656 property Transparent;
1657 property Options: TTabControlOptions read FOptions write SetOptions;
1658 property ImageList: TKOLImageList read FImageList write SetImageList;
1659 property ImageList1stIdx: Integer read FImageList1stIdx write SetImageList1stIdx;
1660 property Count: Integer read GetCount write SetCount;
1661 property Font;
1662 property CurIndex: Integer read GetCurIndex write SetCurIndex stored FALSE;
1663 property OnSelChange;
1664 property edgeType: TEdgeStyle read FedgeType write SetedgeType;
1665 property Border;
1666 property MarginTop;
1667 property MarginBottom;
1668 property MarginLeft;
1669 property MarginRight;
1670 property OnEnter;
1671 property OnLeave;
1672 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
1673 property OnKeyDown;
1674 property OnKeyUp;
1675 property OnChar;
1676 property generateConstants: Boolean read FgenerateConstants write SetgenerateConstants;
1677 property OnDrawItem;
1678 property Brush;
1679 end;
1680
1681 TKOLTabControlEditor = class( TComponentEditor )
1682 // This component editor is to provide easy page select on tab control with
1683 // double click on one of page indicators.
1684 private
1685 protected
1686 public
1687 procedure Edit; override;
1688 procedure ExecuteVerb(Index: Integer); override;
1689 function GetVerb(Index: Integer): string; override;
1690 function GetVerbCount: Integer; override;
1691 end;
1692
1693
1694
1695 //===========================================================================
1696 //---- MIRROR FOR A SCROLL BOX
1697 //---- ÇÅÐÊÀËÎ ÄËß ÎÊÍÀ ÏÐÎÊÐÓÒÊÈ
1698 TScrollBars = ( ssNone, ssHorz, ssVert, ssBoth );
1699
1700 TKOLScrollBox = class( TKOLControl )
1701 private
1702 FScrollBars: TScrollBars;
1703 FControlContainer: Boolean;
1704 FEdgeStyle: TEdgeStyle;
1705 FpopupMenu: TKOLPopupMenu;
1706 fNotAvailable: Boolean;
1707 procedure SetScrollBars(const Value: TScrollBars);
1708 procedure SetControlContainer(const Value: Boolean);
1709 procedure SetEdgeStyle(const Value: TEdgeStyle);
1710 procedure SetpopupMenu(const Value: TKOLPopupMenu);
1711 protected
1712 procedure SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); override;
1713 function SetupParams( const AName, AParent: String ): String; override;
1714 function IsControlContainer: Boolean; virtual;
1715 function TypeName: String; override;
1716 public
1717 published
1718 constructor Create( AOwner: TComponent ); override;
1719 property ScrollBars: TScrollBars read FScrollBars write SetScrollBars;
1720 property ControlContainer: Boolean read FControlContainer write SetControlContainer;
1721 property EdgeStyle: TEdgeStyle read FEdgeStyle write SetEdgeStyle;
1722 property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;
1723 property Border;
1724 property Caption: Boolean read fNotAvailable;
1725 property Enabled;
1726 property MarginBottom;
1727 property MarginLeft;
1728 property MarginRight;
1729 property MarginTop;
1730 property Transparent;
1731 property OnScroll;
1732 property Brush;
1733 end;
1734
1735 procedure Register;
1736
1737
1738 implementation
1739
1740 uses mckCtrlDraw;
1741
1742 procedure Register;
1743 begin
1744 RegisterComponents( 'KOL', [ TKOLButton, TKOLBitBtn, TKOLLabel, TKOLLabelEffect, TKOLPanel,
1745 TKOLSplitter, TKOLGradientPanel, TKOLGroupBox, TKOLCheckBox, TKOLRadioBox,
1746 TKOLEditBox, TKOLMemo, TKOLRichEdit, TKOLListBox, TKOLComboBox, TKOLPaintBox,
1747 TKOLProgressBar, TKOLListView, TKOLTreeView, TKOLToolbar, TKOLTabControl,
1748 TKOLDateTimePicker, TKOLImageShow, TKOLScrollBox, TKOLMDIClient ] );
1749 RegisterPropertyEditor( TypeInfo( string ), TKOLToolbar, 'buttons',
1750 TKOLToolbarButtonsEditor );
1751 RegisterPropertyEditor( TypeInfo( TOnToolbarButtonClick ), TKOLToolbarButton, 'onClick',
1752 TKOLToolButtonOnClickPropEditor );
1753 RegisterPropertyEditor( TypeInfo( string ), TKOLListView, 'Columns',
1754 TKOLLVColumnsPropEditor );
1755 RegisterComponentEditor( TKOLToolbar, TKOLToolbarEditor );
1756 RegisterComponentEditor( TKOLTabControl, TKOLTabControlEditor );
1757 RegisterComponentEditor( TKOLListView, TKOLLVColumnsEditor );
1758 end;
1759
1760 {function CanMapBitmap( Bitmap: TBitmap ): Boolean;
1761 var KOLBmp: KOL.PBitmap;
1762 begin
1763 KOLBmp := NewDIBBitmap( Bitmap.Width, Bitmap.Height, KOL.pf32bit );
1764 TRY
1765 BitBlt( KOLBmp.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height,
1766 Bitmap.Canvas.Handle, 0, 0, SRCCOPY );
1767 KOLBmp.HandleType := KOL.bmDIB;
1768 KOLBmp.PixelFormat := KOL.pf32bit;
1769 case CountSystemColorsUsedInBitmap( KOLBmp ) of
1770 KOL.pf1bit, KOL.pf4bit, KOL.pf8bit: Result := TRUE;
1771 else Result := FALSE
1772 end;
1773 //Rpt( '!!!! CanMapBitmap: ' + Int2Str( Integer( Result ) ) );
1774 FINALLY
1775 KOLBmp.Free;
1776 END;
1777 end;}
1778 (*var BI: TBitmapInfo;
1779 C: Integer;
1780 begin
1781 asm
1782 jmp @@e_signature
1783 DB '#$signature$#', 0
1784 DB 'CanMapBitmap', 0
1785 @@e_signature:
1786 end;
1787 Result := TRUE;
1788 if Bitmap = nil then Exit;
1789 if (Bitmap.Width = 0) or (Bitmap.Height = 0) then Exit;
1790 {$IFNDEF _D2}
1791 if (Bitmap.HandleType = bmDIB) and not (Bitmap.PixelFormat in [pfCustom, pfDevice]) then
1792 begin
1793 //ShowMessage( 'format=' + IntToStr( Integer( Bitmap.PixelFormat ) ) );
1794 Result := Bitmap.PixelFormat in [ pf1bit, pf4bit, pf8bit ];
1795 end
1796 else
1797 {$ENDIF _D2}
1798 begin
1799 if Bitmap.Handle = 0 then
1800 Result := FALSE
1801 else
1802 begin
1803 if GetObject( Bitmap.Handle, Sizeof( BI ), @BI ) = 0 then
1804 Result := FALSE
1805 else
1806 begin
1807 C := BI.bmiHeader.biBitCount;
1808 Result := (C=1) or (C=4) or (C=8);
1809 end;
1810 end;
1811 end;
1812 end;*)
1813
1814 { TKOLButton }
1815
1816 function TKOLButton.CanChangeColor: Boolean;
1817 begin
1818 asm
1819 jmp @@e_signature
1820 DB '#$signature$#', 0
1821 DB 'TKOLButton.CanChangeColor', 0
1822 @@e_signature:
1823 end;
1824 Result := FALSE;
1825 end;
1826
1827 function TKOLButton.CanNotChangeFontColor: Boolean;
1828 begin
1829 asm
1830 jmp @@e_signature
1831 DB '#$signature$#', 0
1832 DB 'TKOLButton.CanNotChangeFontColor', 0
1833 @@e_signature:
1834 end;
1835 Result := TRUE;
1836 end;
1837
1838 function TKOLButton.ClientMargins: TRect;
1839 begin
1840 asm
1841 jmp @@e_signature
1842 DB '#$signature$#', 0
1843 DB 'TKOLButton.ClientMargins', 0
1844 @@e_signature:
1845 end;
1846 Result := Rect( 2, 2, 2, 2 );
1847 end;
1848
1849 constructor TKOLButton.Create(AOwner: TComponent);
1850 begin
1851 asm
1852 jmp @@e_signature
1853 DB '#$signature$#', 0
1854 DB 'TKOLButton.Create', 0
1855 @@e_signature:
1856 end;
1857 inherited;
1858 FImage := TPicture.Create;
1859 FDefIgnoreDefault := TRUE;
1860 FIgnoreDefault := TRUE;
1861 fAutoSzX := 14;
1862 Height := 22; DefaultHeight := 22;
1863 TextAlign := taCenter;
1864 VerticalAlign := vaCenter;
1865 TabStop := True;
1866 end;
1867
1868 procedure TKOLButton.CreateKOLControl(Recreating: boolean);
1869 begin
1870 FKOLCtrl:=NewButton(KOLParentCtrl, '');
1871 end;
1872
1873 function TKOLButton.DefaultParentColor: Boolean;
1874 begin
1875 asm
1876 jmp @@e_signature
1877 DB '#$signature$#', 0
1878 DB 'TKOLButton.DefaultParentColor', 0
1879 @@e_signature:
1880 end;
1881 Result := FALSE;
1882 end;
1883
1884 destructor TKOLButton.Destroy;
1885 begin
1886 FImage.Free;
1887 inherited;
1888 end;
1889
1890 procedure TKOLButton.FirstCreate;
1891 begin
1892 asm
1893 jmp @@e_signature
1894 DB '#$signature$#', 0
1895 DB 'TKOLButton.FirstCreate', 0
1896 @@e_signature:
1897 end;
1898 Caption := Name;
1899 inherited;
1900 end;
1901
1902 function TKOLButton.GenerateTransparentInits: String;
1903 begin
1904 asm
1905 jmp @@e_signature
1906 DB '#$signature$#', 0
1907 DB 'TKOLButton.GenerateTransparentInits', 0
1908 @@e_signature:
1909 end;
1910 Result := inherited GenerateTransparentInits;
1911 if assigned( Fimage ) {and Assigned( Fimage.Graphic ) and
1912 not Fimage.Graphic.Empty} then
1913 begin
1914 if Assigned( image.Icon ) and not image.icon.Empty
1915 {$IFDEF _D2orD3}
1916 and (image.icon.Width > 0) and (image.icon.Height > 0)
1917 {$ENDIF}
1918 then
1919 begin
1920 Result := Result + '.SetButtonIcon( LoadIcon( hInstance, ''' +
1921 ImageResourceName + ''' ) )';
1922 Rpt( 'Button has icon, generating code SetButtonIcon:'#13#10 + Result );
1923 end
1924 else
1925 if Assigned( image.Bitmap ) and not image.Bitmap.Empty then
1926 begin
1927 Rpt( 'Button has bitmap, generating code SetBittonBitmap' );
1928 Result := Result + '.SetButtonBitmap( LoadBitmap( hInstance, ''' +
1929 ImageResourceName + ''' ) )';
1930 end;
1931 end;
1932 if LikeSpeedButton then
1933 Result := Result + '.LikeSpeedButton';
1934 end;
1935
1936 function TKOLButton.ImageResourceName: String;
1937 begin
1938 Result := 'Z' + UpperCase( ParentForm.Name ) + '_' + UpperCase( Name ) + '_IMAGE';
1939 end;
1940
1941 function TKOLButton.NoDrawFrame: Boolean;
1942 begin
1943 Result := TRUE;
1944 end;
1945
1946 procedure TKOLButton.Paint;
1947 begin
1948 if not (Assigned(FKOLCtrl) and (PaintType in [ptWYSIWIG, ptWYSIWIGFrames])) then begin
1949 PrepareCanvasFontForWYSIWIGPaint( Canvas );
1950 DrawButton( Self, Canvas );
1951 end;
1952 inherited;
1953 end;
1954
1955 procedure TKOLButton.SetFlat(const Value: Boolean);
1956 begin
1957 FFlat := Value;
1958 Change;
1959 end;
1960
1961 procedure TKOLButton.Setimage(const Value: TPicture);
1962 begin
1963 TRY
1964 if Assigned( Value ) and Assigned( Value.Graphic ) then
1965 begin
1966 Fimage.Assign( Value.Graphic );
1967 Rpt( '$$$$$$$$$$$$ Success' );
1968 end
1969 else
1970 begin
1971 FImage.Assign( nil );
1972 Rpt( '$$$$$$$$$$$$ nil' );
1973 end;
1974 EXCEPT
1975 Rpt( '$$$$$$$$$$$$ Exception assigning image (' + Name + ')' );
1976 END;
1977 Change;
1978 end;
1979
1980 procedure TKOLButton.SetLikeSpeedButton(const Value: Boolean);
1981 begin
1982 asm
1983 jmp @@e_signature
1984 DB '#$signature$#', 0
1985 DB 'TKOLButton.SetLikeSpeedButton', 0
1986 @@e_signature:
1987 end;
1988 FLikeSpeedButton := Value;
1989 Change;
1990 end;
1991
1992 procedure TKOLButton.SetpopupMenu(const Value: TKOLPopupMenu);
1993 begin
1994 asm
1995 jmp @@e_signature
1996 DB '#$signature$#', 0
1997 DB 'TKOLButton.SetpopupMenu', 0
1998 @@e_signature:
1999 end;
2000 FpopupMenu := Value;
2001 Change;
2002 end;
2003
2004 procedure TKOLButton.SetupColor(SL: TStrings; const AName: String);
2005 begin
2006 asm
2007 jmp @@e_signature
2008 DB '#$signature$#', 0
2009 DB 'TKOLButton.SetupColor', 0
2010 @@e_signature:
2011 end;
2012 // there are no setup color for TKOLButton:
2013 if ClassName = 'TKOLButton' then Exit;
2014 inherited;
2015 end;
2016
2017 procedure TKOLButton.SetupFirst(SL: TStringList; const AName, AParent,
2018 Prefix: String);
2019 var Updated: Boolean;
2020 begin
2021 asm
2022 jmp @@e_signature
2023 DB '#$signature$#', 0
2024 DB 'TKOLButton.SetupFirst', 0
2025 @@e_signature:
2026 end;
2027 inherited;
2028 if Assigned( FpopupMenu ) then
2029 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
2030 ' );' );
2031 if Flat then
2032 if Windowed then
2033 SL.Add( Prefix + AName + '.Style := ' + AName + '.Style or BS_FLAT;' )
2034 else
2035 SL.Add( Prefix + AName + '.Flat := TRUE;' );
2036
2037 if assigned( Fimage ) {and Assigned( Fimage.Graphic ) and
2038 not Fimage.Graphic.Empty} then
2039 begin
2040 if Assigned( image.Icon ) and not image.icon.Empty then
2041 begin
2042 Rpt( 'Button has icon, generate resource' );
2043 SL.Add( '{$R ' + ImageResourceName + '.res}' );
2044 GenerateIconResource( image.Icon, ImageResourceName, ImageResourceName,
2045 Updated );
2046 end
2047 else
2048 if Assigned( image.Bitmap ) and not image.Bitmap.Empty then
2049 begin
2050 Rpt( 'Button has bitmap, generate resource' );
2051 GenerateBitmapResource( image.Bitmap, ImageResourceName, ImageResourceName,
2052 Updated );
2053 end;
2054 end;
2055 end;
2056
2057 procedure TKOLButton.SetupFont(SL: TStrings; const AName: String);
2058 var BFont: TKOLFont;
2059 begin
2060 asm
2061 jmp @@e_signature
2062 DB '#$signature$#', 0
2063 DB 'TKOLButton.SetupFont', 0
2064 @@e_signature:
2065 end;
2066 if (ParentKOLControl = ParentKOLForm) and (ParentKOLForm <> nil) then
2067 BFont := ParentKOLForm.Font
2068 else
2069 if (ParentKOLControl <> nil) and (ParentKOLControl is TKOLCustomControl) then
2070 BFont := (ParentKOLControl as TKOLCustomControl).Font
2071 else
2072 BFont := nil;
2073 if BFont = nil then Exit;
2074 BFont.Color := Font.Color;
2075 if not Font.Equal2( BFont ) then
2076 Font.GenerateCode( SL, AName, BFont );
2077 end;
2078
2079 function TKOLButton.SetupParams(const AName, AParent: String): String;
2080 var
2081 C: string;
2082 begin
2083 asm
2084 jmp @@e_signature
2085 DB '#$signature$#', 0
2086 DB 'TKOLButton.SetupParams', 0
2087 @@e_signature:
2088 end;
2089 if action = nil then
2090 C := StringConstant('Caption',Caption)
2091 else
2092 C := '''''';
2093 Result := AParent + ', ' + C;
2094 end;
2095
2096 const TextAligns: array[ TTextAlign ] of String = ( 'taLeft', 'taRight', 'taCenter' );
2097 VertAligns: array[ TVerticalAlign ] of String = ( 'vaTop', 'vaCenter', 'vaBottom' );
2098
2099 procedure TKOLButton.SetupTextAlign(SL: TStrings; const AName: String);
2100 begin
2101 asm
2102 jmp @@e_signature
2103 DB '#$signature$#', 0
2104 DB 'TKOLButton.SetupTextAlign', 0
2105 @@e_signature:
2106 end;
2107 if TextAlign <> taCenter then
2108 SL.Add( ' ' + AName + '.TextAlign := ' + TextAligns[ TextAlign ] + ';' );
2109 if VerticalAlign <> vaCenter then
2110 SL.Add( ' ' + AName + '.VerticalAlign := ' + VertAligns[ VerticalAlign ] + ';' );
2111 end;
2112
2113 function TKOLButton.TabStopByDefault: Boolean;
2114 begin
2115 asm
2116 jmp @@e_signature
2117 DB '#$signature$#', 0
2118 DB 'TKOLButton.TabStopByDefault', 0
2119 @@e_signature:
2120 end;
2121 Result := TRUE;
2122 end;
2123
2124 function TKOLButton.TypeName: String;
2125 begin
2126 asm
2127 jmp @@e_signature
2128 DB '#$signature$#', 0
2129 DB 'TKOLButton.TypeName', 0
2130 @@e_signature:
2131 end;
2132 Result := inherited TypeName;
2133 {if wordWrap then
2134 Result := 'WordWrap' + Result;}
2135 end;
2136
2137 function TKOLButton.WYSIWIGPaintImplemented: Boolean;
2138 begin
2139 Result := TRUE;
2140 end;
2141
2142 { TKOLLabel }
2143
2144 function TKOLLabel.AdjustVerticalAlign(
2145 Value: TVerticalAlign): TVerticalAlign;
2146 begin
2147 asm
2148 jmp @@e_signature
2149 DB '#$signature$#', 0
2150 DB 'TKOLButton.AdjustVerticalAlign', 0
2151 @@e_signature:
2152 end;
2153 if (Value = vaBottom) and Windowed and not( csLoading in ComponentState ) then
2154 Result := vaCenter
2155 else
2156 Result := Value;
2157 end;
2158
2159 procedure TKOLLabel.CallInheritedPaint;
2160 begin
2161 inherited Paint;
2162 end;
2163
2164 constructor TKOLLabel.Create(AOwner: TComponent);
2165 begin
2166 asm
2167 jmp @@e_signature
2168 DB '#$signature$#', 0
2169 DB 'TKOLLabel.Create', 0
2170 @@e_signature:
2171 end;
2172 inherited;
2173 fAutoSzX := 1;
2174 fAutoSzY := 1;
2175 Height := 22; DefaultHeight := 22;
2176 fTabOrder := -1;
2177 end;
2178
2179 procedure TKOLLabel.FirstCreate;
2180 begin
2181 asm
2182 jmp @@e_signature
2183 DB '#$signature$#', 0
2184 DB 'TKOLLabel.FirstCreate', 0
2185 @@e_signature:
2186 end;
2187 Caption := Name;
2188 inherited;
2189 end;
2190
2191 function TKOLLabel.GetTaborder: Integer;
2192 begin
2193 asm
2194 jmp @@e_signature
2195 DB '#$signature$#', 0
2196 DB 'TKOLLabel.GetTaborder', 0
2197 @@e_signature:
2198 end;
2199 Result := -1;
2200 end;
2201
2202 function TKOLLabel.Get_VertAlign: TVerticalAlign;
2203 begin
2204 asm
2205 jmp @@e_signature
2206 DB '#$signature$#', 0
2207 DB 'TKOLLabel.Get_VertAlign', 0
2208 @@e_signature:
2209 end;
2210 Result := inherited VerticalAlign;
2211 end;
2212
2213 procedure TKOLLabel.Loaded;
2214 begin
2215 inherited;
2216 VerticalAlign := VerticalAlign;
2217 end;
2218
2219 procedure TKOLLabel.Paint;
2220 var
2221 R:TRect;
2222 Flag:DWord;
2223 TMPBrushStyle: TBrushStyle;
2224 begin
2225 asm
2226 jmp @@e_signature
2227 DB '#$signature$#', 0
2228 DB 'TKOLLabel.Paint', 0
2229 @@e_signature:
2230 end;
2231
2232 R.Left:=0;
2233 R.Top:=0;
2234 R.Right:=Width;
2235 R.Bottom:=Height;
2236 Flag:=0;
2237 case TextAlign of
2238 taRight: Flag:=Flag or DT_RIGHT;
2239 taLeft: Flag:=Flag or DT_LEFT;
2240 taCenter: Flag:=Flag or DT_CENTER;
2241 end;
2242
2243 case VerticalAlign of
2244 vaTop: Flag:=Flag or DT_TOP;
2245 vaBottom: Flag:=Flag or DT_BOTTOM;
2246 vaCenter: Flag:=Flag or DT_VCENTER or DT_SINGLELINE;
2247 end;
2248
2249 if (WordWrap) and (not AutoSize or (Align in [ caClient, caTop, caBottom ])) then
2250 Flag:=Flag or DT_WORDBREAK;
2251
2252 PrepareCanvasFontForWYSIWIGPaint( Canvas );
2253
2254 TMPBrushStyle := Canvas.Brush.Style;
2255 Canvas.Brush.Style := bsClear;
2256 DrawText(Canvas.Handle,PChar(Caption),Length(Caption),R,Flag);
2257 Canvas.Brush.Style :=TMPBrushStyle;
2258
2259 inherited;
2260
2261 end;
2262
2263 procedure TKOLLabel.SetpopupMenu(const Value: TKOLPopupMenu);
2264 begin
2265 asm
2266 jmp @@e_signature
2267 DB '#$signature$#', 0
2268 DB 'TKOLLabel.SetpopupMenu', 0
2269 @@e_signature:
2270 end;
2271 FpopupMenu := Value;
2272 Change;
2273 end;
2274
2275 procedure TKOLLabel.SetShowAccelChar(const Value: Boolean);
2276 begin
2277 FShowAccelChar := Value;
2278 Change;
2279 end;
2280
2281 procedure TKOLLabel.SetupFirst(SL: TStringList; const AName, AParent,
2282 Prefix: String);
2283 begin
2284 asm
2285 jmp @@e_signature
2286 DB '#$signature$#', 0
2287 DB 'TKOLLabel.SetupFirst', 0
2288 @@e_signature:
2289 end;
2290 inherited;
2291 if Assigned( FpopupMenu ) then
2292 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
2293 ' );' );
2294 if ShowAccelChar then
2295 SL.Add( Prefix + AName + '.Style := ' + AName + '.Style and not SS_NOPREFIX;' );
2296 end;
2297
2298 function TKOLLabel.SetupParams(const AName, AParent: String): String;
2299 begin
2300 asm
2301 jmp @@e_signature
2302 DB '#$signature$#', 0
2303 DB 'TKOLLabel.SetupParams', 0
2304 @@e_signature:
2305 end;
2306 Result := AParent + ', ' + StringConstant('Caption', Caption);
2307 end;
2308
2309 procedure TKOLLabel.SetupTextAlign(SL: TStrings; const AName: String);
2310 begin
2311 asm
2312 jmp @@e_signature
2313 DB '#$signature$#', 0
2314 DB 'TKOLLabel.SetupTextAlign', 0
2315 @@e_signature:
2316 end;
2317 if TextAlign <> taLeft then
2318 SL.Add( ' ' + AName + '.TextAlign := ' + TextAligns[ TextAlign ] + ';' );
2319 if VerticalAlign <> vaTop then
2320 SL.Add( ' ' + AName + '.VerticalAlign := ' + VertAligns[ VerticalAlign ] + ';' );
2321 end;
2322
2323 procedure TKOLLabel.Set_VertAlign(const Value: TVerticalAlign);
2324 begin
2325 asm
2326 jmp @@e_signature
2327 DB '#$signature$#', 0
2328 DB 'TKOLLabel.Set_VertAlign', 0
2329 @@e_signature:
2330 end;
2331 inherited VerticalAlign := AdjustVerticalAlign( Value );
2332 end;
2333
2334 function TKOLLabel.TypeName: String;
2335 begin
2336 asm
2337 jmp @@e_signature
2338 DB '#$signature$#', 0
2339 DB 'TKOLLabel.TypeName', 0
2340 @@e_signature:
2341 end;
2342 Result := inherited TypeName;
2343 {if wordWrap then
2344 Result := 'WordWrap' + Result;}
2345 end;
2346
2347 function TKOLLabel.WYSIWIGPaintImplemented: Boolean;
2348 begin
2349 asm
2350 jmp @@e_signature
2351 DB '#$signature$#', 0
2352 DB 'TKOLLabel.WYSIWIGPaintImplemented', 0
2353 @@e_signature:
2354 end;
2355 Result := TRUE;
2356 end;
2357
2358 { TKOLPanel }
2359
2360 function TKOLPanel.ClientMargins: TRect;
2361 begin
2362 asm
2363 jmp @@e_signature
2364 DB '#$signature$#', 0
2365 DB 'TKOLPanel.ClientMargins', 0
2366 @@e_signature:
2367 end;
2368 case edgeStyle of
2369 esLowered: Result := Rect( 1, 1, 1, 1 );
2370 esRaised: Result := Rect( 3, 3, 3, 3 );
2371 esNone: Result := Rect( 0, 0, 0, 0 );
2372 end;
2373 end;
2374
2375 constructor TKOLPanel.Create(AOwner: TComponent);
2376 begin
2377 asm
2378 jmp @@e_signature
2379 DB '#$signature$#', 0
2380 DB 'TKOLPanel.Create', 0
2381 @@e_signature:
2382 end;
2383 inherited;
2384 Width := 100; DefaultWidth := Width;
2385 Height := 100; DefaultHeight := 100;
2386 ControlStyle := ControlStyle + [ csAcceptsControls ];
2387 end;
2388
2389 destructor TKOLPanel.Destroy;
2390 var P: TKOLTabControl;
2391 begin
2392 asm
2393 jmp @@e_signature
2394 DB '#$signature$#', 0
2395 DB 'TKOLPanel.Destroy', 0
2396 @@e_signature:
2397 end;
2398 if Parent <> nil then
2399 if Parent is TKOLTabControl then
2400 begin
2401 P:=Parent as TKOLTabControl;
2402 if (P.FCurPage=self) and (P.CurIndex>0) then P.CurIndex:=pred(P.CurIndex);
2403 P.Invalidate;
2404 end;
2405 inherited;
2406 end;
2407
2408 function TKOLPanel.Get_VA: TVerticalAlign;
2409 begin
2410 asm
2411 jmp @@e_signature
2412 DB '#$signature$#', 0
2413 DB 'TKOLPanel.Get_VA', 0
2414 @@e_signature:
2415 end;
2416 Result := inherited VerticalAlign;
2417 end;
2418
2419 function TKOLPanel.NoDrawFrame: Boolean;
2420 begin
2421 asm
2422 jmp @@e_signature
2423 DB '#$signature$#', 0
2424 DB 'TKOLPanel.NoDrawFrame', 0
2425 @@e_signature:
2426 end;
2427 Result := (EdgeStyle <> esNone) or
2428 (Parent <> nil) and (Parent is TKOLTabControl);
2429 end;
2430
2431 procedure TKOLPanel.Paint;
2432 var
2433 R:TRect;
2434 Flag,EdgeFlag:DWord;
2435 Delta:Integer;
2436 begin
2437 asm
2438 jmp @@e_signature
2439 DB '#$signature$#', 0
2440 DB 'TKOLPanel.Paint', 0
2441 @@e_signature:
2442 end;
2443
2444 R.Left:=0;
2445 R.Top:=0;
2446 R.Right:=Width;
2447 R.Bottom:=Height;
2448
2449 case edgeStyle of
2450 esRaised:
2451 begin
2452 EdgeFlag:=EDGE_RAISED;
2453 Delta:=3;
2454 end;
2455
2456 esLowered:
2457 begin
2458 EdgeFlag:=BDR_SUNKENOUTER;
2459 Delta:=1;
2460 end;
2461
2462 //esNone:
2463 else
2464 begin
2465 EdgeFlag:=0;
2466 Delta:=0;
2467 end;
2468 end; //case
2469
2470 if Delta <> 0 then
2471 begin
2472 DrawEdge(Canvas.Handle,R,EdgeFlag,BF_RECT or BF_MIDDLE );
2473 R.Left:=Delta;
2474 R.Top:=Delta;
2475 R.Right:=Width-Delta;
2476 R.Bottom:=Height-Delta;
2477 Canvas.Brush.Color := Color;
2478 Canvas.FillRect( R );
2479 end;
2480
2481 Flag:=0;
2482 case TextAlign of
2483 taRight: Flag:=Flag or DT_RIGHT;
2484 taLeft: Flag:=Flag or DT_LEFT;
2485 taCenter: Flag:=Flag or DT_CENTER;
2486 end; //case
2487
2488 case VerticalAlign of
2489 vaTop: Flag:=Flag or DT_TOP or DT_SINGLELINE;
2490 vaBottom: Flag:=Flag or DT_BOTTOM or DT_SINGLELINE;
2491 vaCenter: Flag:=Flag or DT_VCENTER or DT_SINGLELINE;
2492 end; //case
2493
2494 Flag:=Flag+DT_WORDBREAK;
2495
2496 if not( (Parent <> nil) and (Parent is TKOLTabControl) ) then
2497 begin
2498 PrepareCanvasFontForWYSIWIGPaint( Canvas );
2499 DrawText(Canvas.Handle,PChar(Caption),Length(Caption),R,Flag);
2500 end;
2501
2502 inherited;
2503 end;
2504
2505 function TKOLPanel.RefName: String;
2506 var J: Integer;
2507 begin
2508 asm
2509 jmp @@e_signature
2510 DB '#$signature$#', 0
2511 DB 'TKOLPanel.RefName', 0
2512 @@e_signature:
2513 end;
2514 Result := inherited RefName;
2515 if Parent is TKOLTabControl then
2516 begin
2517 for J := 0 to (Parent as TKOLTabControl).Count - 1 do
2518 if (Parent as TKOLTabControl).Pages[ J ] = Self then
2519 begin
2520 Result := (Parent as TKOLTabControl).RefName + '.Pages[ ' + IntToStr( J ) + ' ]';
2521 break;
2522 end;
2523 end;
2524 end;
2525
2526 procedure TKOLPanel.SetCaption(const Value: String);
2527 begin
2528 inherited;
2529 if (Parent <> nil) and (Parent is TKOLTabControl) then
2530 Parent.Invalidate;
2531 end;
2532
2533 procedure TKOLPanel.SetEdgeStyle(const Value: TEdgeStyle);
2534 begin
2535 asm
2536 jmp @@e_signature
2537 DB '#$signature$#', 0
2538 DB 'TKOLPanel.SetEdgeStyle', 0
2539 @@e_signature:
2540 end;
2541 if FEdgeStyle = Value then Exit;
2542 FEdgeStyle := Value;
2543 Change;
2544 ReAlign( FALSE );
2545 Invalidate;
2546 end;
2547
2548 procedure TKOLPanel.SetpopupMenu(const Value: TKOLPopupMenu);
2549 begin
2550 asm
2551 jmp @@e_signature
2552 DB '#$signature$#', 0
2553 DB 'TKOLPanel.SetpopupMenu', 0
2554 @@e_signature:
2555 end;
2556 FpopupMenu := Value;
2557 Change;
2558 end;
2559
2560 procedure TKOLPanel.SetShowAccelChar(const Value: Boolean);
2561 begin
2562 FShowAccelChar := Value;
2563 Change;
2564 end;
2565
2566 procedure TKOLPanel.SetupConstruct(SL: TStringList; const AName, AParent,
2567 Prefix: String);
2568 begin
2569 asm
2570 jmp @@e_signature
2571 DB '#$signature$#', 0
2572 DB 'TKOLPanel.SetupConstruct', 0
2573 @@e_signature:
2574 end;
2575 if Parent <> nil then
2576 if Parent is TKOLTabControl then
2577 Exit; // this is not a panel, but a tab page on tab control.
2578 inherited;
2579 end;
2580
2581 procedure TKOLPanel.SetupFirst(SL: TStringList; const AName,
2582 AParent, Prefix: String);
2583 begin
2584 asm
2585 jmp @@e_signature
2586 DB '#$signature$#', 0
2587 DB 'TKOLPanel.SetupFirst', 0
2588 @@e_signature:
2589 end;
2590 inherited;
2591 if Parent <> nil then
2592 if Parent is TKOLTabControl then
2593 Exit; // this is not a panel, but a tab page on tab control.
2594 if Caption <> '' then
2595 SL.Add( Prefix + AName + '.Caption := ' + StringConstant('Caption', Caption) + ';' );
2596 if Assigned( FpopupMenu ) then
2597 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
2598 ' );' );
2599 if ShowAccelChar then
2600 SL.Add( Prefix + AName + '.Style := ' + AName + '.Style and not SS_NOPREFIX;' );
2601 end;
2602
2603 function TKOLPanel.SetupParams(const AName, AParent: String): String;
2604 const EdgeStyles: array[ TEdgeStyle ] of String = ( 'esRaised', 'esLowered', 'esNone' );
2605 begin
2606 asm
2607 jmp @@e_signature
2608 DB '#$signature$#', 0
2609 DB 'TKOLPanel.SetupParams', 0
2610 @@e_signature:
2611 end;
2612 Result := AParent + ', ' + EdgeStyles[ EdgeStyle ];
2613 end;
2614
2615 procedure TKOLPanel.SetupTextAlign(SL: TStrings; const AName: String);
2616 begin
2617 asm
2618 jmp @@e_signature
2619 DB '#$signature$#', 0
2620 DB 'TKOLPanel.SetupTextAlign', 0
2621 @@e_signature:
2622 end;
2623 if TextAlign <> taLeft then
2624 SL.Add( ' ' + AName + '.TextAlign := ' + TextAligns[ TextAlign ] + ';' );
2625 if VerticalAlign <> vaTop then
2626 SL.Add( ' ' + AName + '.VerticalAlign := ' + VertAligns[ VerticalAlign ] + ';' );
2627 end;
2628
2629 procedure TKOLPanel.Set_VA(const Value: TVerticalAlign);
2630 begin
2631 asm
2632 jmp @@e_signature
2633 DB '#$signature$#', 0
2634 DB 'TKOLPanel.Set_VA', 0
2635 @@e_signature:
2636 end;
2637 if Value = vaBottom then
2638 inherited VerticalAlign := vaCenter
2639 else
2640 inherited VerticalAlign := Value;
2641 end;
2642
2643 function TKOLPanel.WYSIWIGPaintImplemented: Boolean;
2644 begin
2645 asm
2646 jmp @@e_signature
2647 DB '#$signature$#', 0
2648 DB 'TKOLPanel.WYSIWIGPaintImplemented', 0
2649 @@e_signature:
2650 end;
2651 Result := TRUE;
2652 end;
2653
2654 { TKOLBitBtn }
2655
2656 procedure TKOLBitBtn.AssignEvents(SL: TStringList; const AName: String);
2657 begin
2658 asm
2659 jmp @@e_signature
2660 DB '#$signature$#', 0
2661 DB 'TKOLBitBtn.AssignEvents', 0
2662 @@e_signature:
2663 end;
2664 inherited;
2665 DoAssignEvents( SL, AName, [ 'OnTestMouseOver' ], [ @OnTestMouseOver ] );
2666 end;
2667
2668 procedure TKOLBitBtn.AutoSizeNow;
2669 var TmpBmp: graphics.TBitmap;
2670 W, H, I: Integer;
2671 begin
2672 asm
2673 jmp @@e_signature
2674 DB '#$signature$#', 0
2675 DB 'TKOLBitBtn.AutoSizeNow', 0
2676 @@e_signature:
2677 end;
2678 if fAutoSizingNow then Exit;
2679 fAutoSizingNow := TRUE;
2680 TmpBmp := graphics.TBitmap.Create;
2681 try
2682 TmpBmp.Width := 10;
2683 TmpBmp.Height := 10;
2684 //Rpt( 'TmpBmp.Width=' + IntToStr( TmpBmp.Width ) + ' TmpBmp.Height=' + IntToStr( TmpBmp.Height ) );
2685 TmpBmp.Canvas.Font.Name := Font.FontName;
2686 TmpBmp.Canvas.Font.Style := TFontStyles(Font.FontStyle);
2687 if Font.FontHeight > 0 then
2688 TmpBmp.Canvas.Font.Height := Font.FontHeight
2689 else
2690 if Font.FontHeight < 0 then
2691 TmpBmp.Canvas.Font.Size := - Font.FontHeight
2692 else
2693 TmpBmp.Canvas.Font.Size := 0;
2694 W := TmpBmp.Canvas.TextWidth( Caption );
2695 if fsItalic in TFontStyles( Font.FontStyle ) then
2696 Inc( W, TmpBmp.Canvas.TextWidth( ' ' ) );
2697 H := TmpBmp.Canvas.TextHeight( 'Ap^_' );
2698 //Rpt( 'W=' + IntToStr( W ) + ' H=' + IntToStr( H ) );
2699 if Align in [ caNone, caLeft, caRight ] then
2700 begin
2701 if (glyphBitmap.Width > 0) and (glyphBitmap.Height > 0) then
2702 begin
2703 I := glyphBitmap.Width;
2704 if glyphCount > 1 then
2705 I := I div glyphCount;
2706 if glyphLayout in [ glyphLeft, glyphRight ] then
2707 W := W + I
2708 else
2709 if W < I then
2710 W := I;
2711 end;
2712 if not (bboNoBorder in options) then
2713 Inc( W, 4 );
2714 Width := W + fAutoSzX;
2715 end;
2716 if Align in [ caNone, caTop, caBottom ] then
2717 begin
2718 if (glyphBitmap.Width > 0) and (glyphBitmap.Height > 0) then
2719 begin
2720 I := glyphBitmap.Height;
2721 if glyphLayout in [ glyphTop, glyphBottom ] then
2722 H := H + I + fAutoSzY
2723 else
2724 H := I;
2725 end;
2726 if not (bboNoBorder in options) then
2727 Inc( H, 4 );
2728 Height := H; // + fAutoSzY;
2729 end;
2730 finally
2731 TmpBmp.Free;
2732 fAutoSizingNow := FALSE;
2733 end;
2734 end;
2735
2736 function TKOLBitBtn.ClientMargins: TRect;
2737 begin
2738 asm
2739 jmp @@e_signature
2740 DB '#$signature$#', 0
2741 DB 'TKOLBitBtn.ClientMargins', 0
2742 @@e_signature:
2743 end;
2744 Result := Rect( 3, 3, 3, 3 );
2745 end;
2746
2747 constructor TKOLBitBtn.Create(AOwner: TComponent);
2748 begin
2749 asm
2750 jmp @@e_signature
2751 DB '#$signature$#', 0
2752 DB 'TKOLBitBtn.Create', 0
2753 @@e_signature:
2754 end;
2755 inherited;
2756 FDefIgnoreDefault := TRUE;
2757 FIgnoreDefault := TRUE;
2758 fAutoSzX := 8;
2759 fAutoSzY := 8;
2760 FGlyphBitmap := TBitmap.Create;
2761 Height := 22; DefaultHeight := 22;
2762 DefaultWidth := Width;
2763 TextAlign := taCenter;
2764 VerticalAlign := vaCenter;
2765 TabStop := True;
2766 fTextShiftX := 1;
2767 fTextShiftY := 1;
2768 end;
2769
2770 procedure TKOLBitBtn.CreateKOLControl(Recreating: boolean);
2771 begin
2772 FKOLCtrl:=NewBitBtn(KOLParentCtrl, '', [], glyphLeft, 0, 0);
2773 end;
2774
2775 destructor TKOLBitBtn.Destroy;
2776 begin
2777 asm
2778 jmp @@e_signature
2779 DB '#$signature$#', 0
2780 DB 'TKOLBitBtn.Destroy', 0
2781 @@e_signature:
2782 end;
2783 FGlyphBitmap.Free;
2784 if ImageList <> nil then
2785 ImageList.NotifyLinkedComponent( Self, noRemoved );
2786 inherited;
2787 end;
2788
2789 procedure TKOLBitBtn.FirstCreate;
2790 begin
2791 asm
2792 jmp @@e_signature
2793 DB '#$signature$#', 0
2794 DB 'TKOLBitBtn.FirstCreate', 0
2795 @@e_signature:
2796 end;
2797 Caption := Name;
2798 inherited;
2799 end;
2800
2801 function TKOLBitBtn.GenerateTransparentInits: String;
2802 begin
2803 asm
2804 jmp @@e_signature
2805 DB '#$signature$#', 0
2806 DB 'TKOLBitBtn.GenerateTransparentInits', 0
2807 @@e_signature:
2808 end;
2809 if autoAdjustSize then
2810 begin
2811 DefaultWidth := Width;
2812 DefaultHeight := Height;
2813 end;
2814 Result := inherited GenerateTransparentInits;
2815 if LikeSpeedButton then
2816 Result := Result + '.LikeSpeedButton';
2817 end;
2818
2819 function TKOLBitBtn.NoDrawFrame: Boolean;
2820 begin
2821 Result:=HasBorder;
2822 end;
2823
2824 procedure TKOLBitBtn.NotifyLinkedComponent(Sender: TObject;
2825 Operation: TNotifyOperation);
2826 begin
2827 asm
2828 jmp @@e_signature
2829 DB '#$signature$#', 0
2830 DB 'TKOLBitBtn.NotifyLinkedComponent', 0
2831 @@e_signature:
2832 end;
2833 inherited;
2834 if Operation = noRemoved then
2835 ImageList := nil;
2836 end;
2837
2838 procedure TKOLBitBtn.RecalcSize;
2839 begin
2840 asm
2841 jmp @@e_signature
2842 DB '#$signature$#', 0
2843 DB 'TKOLBitBtn.RecalcSize', 0
2844 @@e_signature:
2845 end;
2846 if (ImageList <> nil) or
2847 (GlyphBitmap.Width <> 0) and (GlyphBitmap.Height <> 0) then
2848 begin
2849 DefaultWidth := 0;
2850 DefaultHeight := 0;
2851 end
2852 else
2853 begin
2854 DefaultWidth := 64;
2855 DefaultHeight := 22;
2856 end;
2857 end;
2858
2859 procedure TKOLBitBtn.SetautoAdjustSize(const Value: Boolean);
2860 begin
2861 asm
2862 jmp @@e_signature
2863 DB '#$signature$#', 0
2864 DB 'TKOLBitBtn.SetautoAdjustSize', 0
2865 @@e_signature:
2866 end;
2867 FautoAdjustSize := Value;
2868 Change;
2869 end;
2870
2871 procedure TKOLBitBtn.SetBitBtnDrawMnemonic(const Value: Boolean);
2872 begin
2873 asm
2874 jmp @@e_signature
2875 DB '#$signature$#', 0
2876 DB 'TKOLBitBtn.SetBitBtnDrawMnemonic', 0
2877 @@e_signature:
2878 end;
2879 FBitBtnDrawMnemonic := Value;
2880 Change;
2881 end;
2882
2883 procedure TKOLBitBtn.SetFlat(const Value: Boolean);
2884 begin
2885 asm
2886 jmp @@e_signature
2887 DB '#$signature$#', 0
2888 DB 'TKOLBitBtn.SetFlat', 0
2889 @@e_signature:
2890 end;
2891 FFlat := Value;
2892 Change;
2893 end;
2894
2895 procedure TKOLBitBtn.SetGlyphBitmap(const Value: TBitmap);
2896 begin
2897 asm
2898 jmp @@e_signature
2899 DB '#$signature$#', 0
2900 DB 'TKOLBitBtn.SetGlyphBitmap', 0
2901 @@e_signature:
2902 end;
2903 if (Value <> nil) and (not Value.Empty) then
2904 begin
2905 FGlyphBitmap.Assign( Value );
2906 FOptions := FOptions - [bboImageList];
2907 FImageList := nil;
2908 end
2909 else
2910 begin
2911 {FGlyphBitmap.Width := 0;
2912 FGlyphBitmap.Height := 0;}
2913 FGlyphBitmap.Free;
2914 FGlyphBitmap := TBitmap.Create;
2915 end;
2916 FGlyphCount := 0;
2917 if FGlyphBitmap.Height > 0 then
2918 FGlyphCount := FGlyphBitmap.Width div FGlyphBitmap.Height;
2919 RecalcSize;
2920 if (DefaultWidth <> 0) and (DefaultHeight <> 0) then
2921 begin
2922 Width := DefaultWidth;
2923 Height := DefaultHeight;
2924 end;
2925 Change;
2926 end;
2927
2928 procedure TKOLBitBtn.SetGlyphCount(Value: Integer);
2929 begin
2930 asm
2931 jmp @@e_signature
2932 DB '#$signature$#', 0
2933 DB 'TKOLBitBtn.SetGlyphCount', 0
2934 @@e_signature:
2935 end;
2936 if Value < 0 then
2937 Value := 0;
2938 if Value > 5 then
2939 Value := 5;
2940 if Value = FGlyphCount then Exit;
2941 FGlyphCount := Value;
2942 Change;
2943 end;
2944
2945 procedure TKOLBitBtn.SetGlyphLayout(const Value: TGlyphLayout);
2946 begin
2947 asm
2948 jmp @@e_signature
2949 DB '#$signature$#', 0
2950 DB 'TKOLBitBtn.SetGlyphLayout', 0
2951 @@e_signature:
2952 end;
2953 FGlyphLayout := Value;
2954 if AutoSize then
2955 AutoSizeNow;
2956 Change;
2957 end;
2958
2959 procedure TKOLBitBtn.SetImageIndex(const Value: Integer);
2960 begin
2961 asm
2962 jmp @@e_signature
2963 DB '#$signature$#', 0
2964 DB 'TKOLBitBtn.SetImageIndex', 0
2965 @@e_signature:
2966 end;
2967 FImageIndex := Value;
2968 Change;
2969 end;
2970
2971 procedure TKOLBitBtn.SetImageList(const Value: TKOLImageList);
2972 begin
2973 asm
2974 jmp @@e_signature
2975 DB '#$signature$#', 0
2976 DB 'TKOLBitBtn.SetImageList', 0
2977 @@e_signature:
2978 end;
2979 if FImageList <> nil then
2980 FImageList.NotifyLinkedComponent( Self, noRemoved );
2981 FImageList := Value;
2982 if (Value <> nil) and (Value is TKOLImageList) then
2983 begin
2984 FGlyphBitmap.Width := 0;
2985 FGlyphBitmap.Height := 0;
2986 FOptions := FOptions + [bboImageList];
2987 Value.AddToNotifyList( Self );
2988 end
2989 else
2990 FOptions := FOptions - [bboImageList];
2991 Change;
2992 end;
2993
2994 procedure TKOLBitBtn.SetLikeSpeedButton(const Value: Boolean);
2995 begin
2996 asm
2997 jmp @@e_signature
2998 DB '#$signature$#', 0
2999 DB 'TKOLBitBtn.SetLikeSpeedButton', 0
3000 @@e_signature:
3001 end;
3002 FLikeSpeedButton := Value;
3003 Change;
3004 end;
3005
3006 procedure TKOLBitBtn.SetOnTestMouseOver(const Value: TOnTestMouseOver);
3007 begin
3008 asm
3009 jmp @@e_signature
3010 DB '#$signature$#', 0
3011 DB 'TKOLBitBtn.SetOnTestMouseOver', 0
3012 @@e_signature:
3013 end;
3014 FOnTestMouseOver := Value;
3015 Change;
3016 end;
3017
3018 procedure TKOLBitBtn.SetOptions(Value: TBitBtnOptions);
3019 begin
3020 asm
3021 jmp @@e_signature
3022 DB '#$signature$#', 0
3023 DB 'TKOLBitBtn.SetOptions', 0
3024 @@e_signature:
3025 end;
3026 Value := Value - [ bboImageList ];
3027 if Assigned( ImageList ) then
3028 Value := Value + [bboImageList];
3029 FOptions := Value;
3030 Change;
3031 end;
3032
3033 function BitBtnOptions( Options: TBitBtnOptions ): String;
3034 begin
3035 asm
3036 jmp @@e_signature
3037 DB '#$signature$#', 0
3038 DB 'BitBtnOptions', 0
3039 @@e_signature:
3040 end;
3041 Result := '';
3042 if bboImageList in Options then
3043 Result := 'bboImageList, ';
3044 if bboNoBorder in Options then
3045 Result := Result + 'bboNoBorder, ';
3046 if bboNoCaption in Options then
3047 Result := Result + 'bboNoCaption, ';
3048 if bboFixed in Options then
3049 Result := Result + 'bboFixed, ';
3050 Result := Trim( Result );
3051 if Result <> '' then
3052 Result := Copy( Result, 1, Length( Result ) - 1 );
3053 Result := '[ ' + Result + ' ]';
3054 end;
3055
3056 procedure TKOLBitBtn.SetpopupMenu(const Value: TKOLPopupMenu);
3057 begin
3058 asm
3059 jmp @@e_signature
3060 DB '#$signature$#', 0
3061 DB 'TKOLBitBtn.SetpopupMenu', 0
3062 @@e_signature:
3063 end;
3064 FpopupMenu := Value;
3065 Change;
3066 end;
3067
3068 procedure TKOLBitBtn.SetRepeatInterval(const Value: Integer);
3069 begin
3070 asm
3071 jmp @@e_signature
3072 DB '#$signature$#', 0
3073 DB 'TKOLBitBtn.SetRepeatInterval', 0
3074 @@e_signature:
3075 end;
3076 FRepeatInterval := Value;
3077 Change;
3078 end;
3079
3080 procedure TKOLBitBtn.SetTextShiftX(const Value: Integer);
3081 begin
3082 asm
3083 jmp @@e_signature
3084 DB '#$signature$#', 0
3085 DB 'TKOLBitBtn.SetTextShiftX', 0
3086 @@e_signature:
3087 end;
3088 FTextShiftX := Value;
3089 Change;
3090 end;
3091
3092 procedure TKOLBitBtn.SetTextShiftY(const Value: Integer);
3093 begin
3094 asm
3095 jmp @@e_signature
3096 DB '#$signature$#', 0
3097 DB 'TKOLBitBtn.SetTextShiftY', 0
3098 @@e_signature:
3099 end;
3100 FTextShiftY := Value;
3101 Change;
3102 end;
3103
3104 procedure TKOLBitBtn.SetupFirst(SL: TStringList; const AName,
3105 AParent, Prefix: String);
3106 var RName: String;
3107 begin
3108 asm
3109 jmp @@e_signature
3110 DB '#$signature$#', 0
3111 DB 'TKOLBitBtn.SetupFirst', 0
3112 @@e_signature:
3113 end;
3114 if ImageList = nil then
3115 if Assigned( GlyphBitmap ) and
3116 (GlyphBitmap.Width <> 0) and (GlyphBitmap.Height <> 0) then
3117 begin
3118 RName := ParentKOLForm.FormName + '_' + Name;
3119 Rpt( 'Prepare resource ' + RName + ' (' + UpperCase( Name + '_BITMAP' ) + ')' );
3120 GenerateBitmapResource( GlyphBitmap, UpperCase( Name + '_BITMAP' ), RName, fUpdated );
3121 SL.Add( Prefix + '{$R ' + RName + '.res}' );
3122 end;
3123 inherited;
3124 if (Height = DefaultHeight) or autoAdjustSize then
3125 if imageList <> nil then
3126 if ImageIndex >= 0 then
3127 SL.Add( Prefix + AName + '.Height := ' + IntToStr( Height ) + ';' );
3128 if (Width = DefaultWidth) or autoAdjustSize then
3129 if imageList <> nil then
3130 if ImageIndex >= 0 then
3131 SL.Add( Prefix + AName + '.Width := ' + IntToStr( Width ) + ';' );
3132 if RepeatInterval > 0 then
3133 SL.Add( Prefix + AName + '.RepeatInterval := ' + IntToStr( RepeatInterval ) + ';' );
3134 if Flat then
3135 SL.Add( Prefix + AName + '.Flat := TRUE;' );
3136 if BitBtnDrawMnemonic then
3137 SL.Add( Prefix + AName + '.BitBtnDrawMnemonic := TRUE;' );
3138 if Assigned( FpopupMenu ) then
3139 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
3140 ' );' );
3141 if TextShiftX <> 0 then
3142 SL.Add( Prefix + AName + '.TextShiftX := ' + IntToStr( TextShiftX ) + ';' );
3143 if TextShiftY <> 0 then
3144 SL.Add( Prefix + AName + '.TextShiftY := ' + IntToStr( TextShiftY ) + ';' );
3145
3146 end;
3147
3148 function TKOLBitBtn.SetupParams(const AName, AParent: String): String;
3149 const Layouts: array[ TGlyphLayout ] of String = ( 'glyphLeft', 'glyphTop',
3150 'glyphRight', 'glyphBottom', 'glyphOver' );
3151 var S, U, C: String;
3152 begin
3153 asm
3154 jmp @@e_signature
3155 DB '#$signature$#', 0
3156 DB 'TKOLBitBtn.SetupParams', 0
3157 @@e_signature:
3158 end;
3159 S := '0';
3160 U := '0';
3161 if (GlyphBitmap <> nil) and
3162 (GlyphBitmap.Width <> 0) and (GlyphBitmap.Height <> 0) then
3163 begin
3164 S := 'LoadBmp( hInstance, ' + String2Pascal(UpperCase( Name + '_BITMAP' )) +
3165 ', Result )';
3166 U := IntToStr( GlyphCount );
3167 end
3168 else
3169 if (ImageList <> nil) then
3170 begin
3171 if ImageList.ParentFORM.Name = ParentForm.Name then
3172 S := 'Result.' + ImageList.Name + '.Handle'
3173 else S := ImageList.ParentFORM.Name +'.'+ ImageList.Name + '.Handle';
3174 if GlyphCount > 0 then
3175 U := '$' + Int2Hex( GlyphCount shl 16, 5 ) + ' + ' + IntToStr( ImageIndex )
3176 else
3177 U := IntToStr( ImageIndex );
3178 end;
3179 if action = nil then
3180 C := StringConstant('Caption',Caption)
3181 else
3182 C := '''''';
3183 Result := AParent + ', ' + C + ', ' +
3184 BitBtnOptions( Options ) + ', ' +
3185 Layouts[ GlyphLayout ] + ', ' + S + ', ' + U;
3186 end;
3187
3188 procedure TKOLBitBtn.SetupTextAlign(SL: TStrings; const AName: String);
3189 begin
3190 asm
3191 jmp @@e_signature
3192 DB '#$signature$#', 0
3193 DB 'TKOLBitBtn.SetupTextAlign', 0
3194 @@e_signature:
3195 end;
3196 if TextAlign <> taCenter then
3197 SL.Add( ' ' + AName + '.TextAlign := ' + TextAligns[ TextAlign ] + ';' );
3198 if VerticalAlign <> vaCenter then
3199 SL.Add( ' ' + AName + '.VerticalAlign := ' + VertAligns[ VerticalAlign ] + ';' );
3200 end;
3201
3202 function TKOLBitBtn.TabStopByDefault: Boolean;
3203 begin
3204 asm
3205 jmp @@e_signature
3206 DB '#$signature$#', 0
3207 DB 'TKOLBitBtn.TabStopByDefault', 0
3208 @@e_signature:
3209 end;
3210 Result := TRUE;
3211 end;
3212
3213 { TKOLGradientPanel }
3214
3215 constructor TKOLGradientPanel.Create(AOwner: TComponent);
3216 begin
3217 asm
3218 jmp @@e_signature
3219 DB '#$signature$#', 0
3220 DB 'TKOLGradientPanel.Create', 0
3221 @@e_signature:
3222 end;
3223 inherited;
3224 Width := 40; DefaultWidth := Width;
3225 Height := 40; DefaultHeight := Height;
3226 ControlStyle := ControlStyle + [ csAcceptsControls ];
3227 FColor1 := clBlue;
3228 FColor2 := clNavy;
3229 //Transparent := TRUE;
3230 gradientLayout := glTop;
3231 gradientStyle := gsVertical;
3232 end;
3233
3234 function TKOLGradientPanel.NoDrawFrame: Boolean;
3235 begin
3236 asm
3237 jmp @@e_signature
3238 DB '#$signature$#', 0
3239 DB 'TKOLGradientPanel.NoDrawFrame', 0
3240 @@e_signature:
3241 end;
3242 Result := TRUE;
3243 end;
3244
3245 procedure TKOLGradientPanel.Paint;
3246
3247 function Ceil( X: Double ): Integer;
3248 begin
3249 Result := Round( X );
3250 end;
3251 const
3252 SQRT2 = 1.4142135623730950488016887242097;
3253
3254 var
3255 // R:TRect;
3256 // Flag:DWord;
3257 // Delta: Integer;
3258 CR:TRect;
3259 W,H,WH,I:Integer;
3260 BMP:TBitmap;
3261 C:TColor;
3262 R,G,B,R1,G1,B1:Byte;
3263
3264 RC, RF, R0: TRect;
3265 C2: TColor;
3266 R2, G2, B2: Integer;
3267 DX1, DX2, DY1, DY2, DR, DG, DB, K: Double;
3268 // PaintStruct: TPaintStruct;
3269 Br: HBrush;
3270 Rgn: HRgn;
3271 Poly: array[ 0..3 ] of TPoint;
3272 // OldPaintDC: HDC;
3273 // RRR:TRect;
3274 begin
3275 asm
3276 jmp @@e_signature
3277 DB '#$signature$#', 0
3278 DB 'TKOLGradientPanel.Paint', 0
3279 @@e_signature:
3280 end;
3281
3282 PrepareCanvasFontForWYSIWIGPaint( Canvas );
3283 case fGradientStyle of
3284 gsHorizontal,gsVertical:
3285 begin
3286 CR := ClientRect;
3287 W := 1;
3288 H := CR.Bottom;
3289 WH := H;
3290 //Bmp := nil;
3291 if fGradientStyle = gsHorizontal then
3292 begin
3293 W := CR.Right;
3294 H := 1;
3295 WH := W;
3296 end;
3297 Bmp :=TBitmap.Create();
3298 Bmp.Width:=W;
3299 Bmp.Height:=H;
3300 C := Color2RGB( fColor1 );
3301 R := C shr 16;
3302 G := (C shr 8) and $FF;
3303 B := C and $FF;
3304 C := Color2RGB( fColor2 );
3305 R1 := C shr 16;
3306 G1 := (C shr 8) and $FF;
3307 B1 := C and $FF;
3308 for I := 0 to WH-1 do
3309 begin
3310 C := ((( R + (R1 - R) * I div WH ) and $FF) shl 16) or
3311 ((( G + (G1 - G) * I div WH ) and $FF) shl 8) or
3312 ( B + (B1 - B) * I div WH ) and $FF;
3313
3314 if fGradientStyle = gsVertical then
3315 Bmp.Canvas.Pixels[0,I]:=C
3316 else
3317 Bmp.Canvas.Pixels[I,0]:=C;
3318 end;
3319 Canvas.StretchDraw(CR,BMP);
3320 Bmp.Free; {YS}//! Memory leak fix
3321 end;
3322
3323 gsRectangle, gsRombic, gsElliptic:
3324 begin
3325
3326 C := Color2RGB( fColor2 );
3327 R2 := C and $FF;
3328 G2 := (C shr 8) and $FF;
3329 B2 := (C shr 16) and $FF;
3330 C := Color2RGB( fColor1 );
3331 R1 := C and $FF;
3332 G1 := (C shr 8) and $FF;
3333 B1 := (C shr 16) and $FF;
3334 DR := (R2 - R1) / 256;
3335 DG := (G2 - G1) / 256;
3336 DB := (B2 - B1) / 256;
3337 {OldPaintDC :=} Canvas.handle;//fPaintDC;
3338 // Self_.fPaintDC := Msg.wParam;
3339 // if Self_.fPaintDC = 0 then
3340 // Self_.fPaintDC := BeginPaint( Self_.fHandle, PaintStruct );
3341 RC := ClientRect;
3342 case fGradientStyle of
3343 gsRombic:
3344 RF := MakeRect( 0, 0, RC.Right div 128, RC.Bottom div 128 );
3345 gsElliptic:
3346 RF := MakeRect( 0, 0, Ceil( RC.Right / 256 * SQRT2 ), Ceil( RC.Bottom / 256 * SQRT2 ) );
3347 else
3348 RF := MakeRect( 0, 0, RC.Right div 256, RC.Bottom div 256 );
3349 end;
3350 case fGradientStyle of
3351 gsRectangle, gsRombic, gsElliptic:
3352 begin
3353 case FGradientLayout of
3354 glCenter, glTop, glBottom:
3355 OffsetRect( RF, (RC.Right - RF.Right) div 2, 0 );
3356 glTopRight, glBottomRight, glRight:
3357 OffsetRect( RF, RC.Right - RF.Right div 2, 0 );
3358 glTopLeft, glBottomLeft, glLeft:
3359 OffsetRect( RF, -RF.Right div 2, 0 );
3360 end;
3361 case FGradientLayout of
3362 glCenter, glLeft, glRight:
3363 OffsetRect( RF, 0, (RC.Bottom - RF.Bottom) div 2 );
3364 glBottom, glBottomLeft, glBottomRight:
3365 OffsetRect( RF, 0, RC.Bottom - RF.Bottom div 2 );
3366 glTop, glTopLeft, glTopRight:
3367 OffsetRect( RF, 0, -RF.Bottom div 2 );
3368 end;
3369 end;
3370 end;
3371 DX1 := (-RF.Left) / 255;
3372 DY1 := (-RF.Top) / 255;
3373 DX2 := (RC.Right - RF.Right) / 255;
3374 DY2 := (RC.Bottom - RF.Bottom) / 255;
3375 case fGradientStyle of
3376 gsRombic, gsElliptic:
3377 begin
3378 if DX2 < -DX1 then DX2 := -DX1;
3379 if DY2 < -DY1 then DY2 := -DY1;
3380 K := 2;
3381 if fGradientStyle = gsElliptic then K := SQRT2;
3382 DX2 := DX2 * K;
3383 DY2 := DY2 * K;
3384 DX1 := -DX2;
3385 DY1 := -DY2;
3386 end;
3387 end;
3388 C2 := C;
3389 for I := 0 to 255 do
3390 begin
3391 if (I < 255) then
3392 begin
3393 C2 := TColor( (( Ceil( B1 + DB * (I+1) ) and $FF) shl 16) or
3394 (( Ceil( G1 + DG * (I+1) ) and $FF) shl 8) or
3395 Ceil( R1 + DR * (I+1) ) and $FF );
3396 if (fGradientStyle in [gsRombic,gsElliptic,gsRectangle]) and
3397 (C2 = C) then continue;
3398 end;
3399 Br := CreateSolidBrush( C );
3400 R0 := MakeRect( Ceil( RF.Left + DX1 * I ),
3401 Ceil( RF.Top + DY1 * I ),
3402 Ceil( RF.Right + DX2 * I ),
3403 Ceil( RF.Bottom + DY2 * I ) );
3404 Rgn := 0;
3405 case fGradientStyle of
3406 gsRectangle:
3407 Rgn := CreateRectRgnIndirect( R0 );
3408 gsRombic:
3409 begin
3410 Poly[ 0 ].x := R0.Left;
3411 Poly[ 0 ].y := R0.Top + (R0.Bottom - R0.Top) div 2;
3412 Poly[ 1 ].x := R0.Left + (R0.Right - R0.Left) div 2;
3413 Poly[ 1 ].y := R0.Top;
3414 Poly[ 2 ].x := R0.Right;
3415 Poly[ 2 ].y := Poly[ 0 ].y;
3416 Poly[ 3 ].x := Poly[ 1 ].x;
3417 Poly[ 3 ].y := R0.Bottom;
3418 Rgn := CreatePolygonRgn( Poly[ 0 ].x, 4, ALTERNATE );
3419 end;
3420 gsElliptic:
3421 Rgn := CreateEllipticRgnIndirect( R0 );
3422 end;
3423 if Rgn <> 0 then
3424 begin
3425 if Rgn <> NULLREGION then
3426 begin
3427 Windows.FillRgn({ fPaintDC}Canvas.Handle, Rgn, Br );
3428 ExtSelectClipRgn( {fPaintDC}Canvas.Handle, Rgn, RGN_DIFF );
3429 end;
3430 DeleteObject( Rgn );
3431 end;
3432 DeleteObject( Br );
3433 C := C2;
3434 end;
3435 // if Self_.fPaintDC <> HDC( Msg.wParam ) then
3436 // EndPaint( Self_.fHandle, PaintStruct );
3437 // Self_.fPaintDC := OldPaintDC;
3438
3439 end;
3440
3441 end; //case
3442
3443 inherited;
3444
3445 end;
3446
3447 procedure TKOLGradientPanel.SetColor1(const Value: TColor);
3448 begin
3449 asm
3450 jmp @@e_signature
3451 DB '#$signature$#', 0
3452 DB 'TKOLGradientPanel.SetColor1', 0
3453 @@e_signature:
3454 end;
3455 FColor1 := Value;
3456 Invalidate;
3457 Change;
3458 end;
3459
3460 procedure TKOLGradientPanel.SetColor2(const Value: TColor);
3461 begin
3462 asm
3463 jmp @@e_signature
3464 DB '#$signature$#', 0
3465 DB 'TKOLGradientPanel.SetColor2', 0
3466 @@e_signature:
3467 end;
3468 FColor2 := Value;
3469 Invalidate;
3470 Change;
3471 end;
3472
3473 procedure TKOLGradientPanel.SetgradientLayout(
3474 const Value: TGradientLayout);
3475 begin
3476 asm
3477 jmp @@e_signature
3478 DB '#$signature$#', 0
3479 DB 'TKOLGradientPanel.SetgradientLayout', 0
3480 @@e_signature:
3481 end;
3482 FgradientLayout := Value;
3483 Invalidate;
3484 Change;
3485 end;
3486
3487 procedure TKOLGradientPanel.SetgradientStyle(const Value: TGradientStyle);
3488 begin
3489 asm
3490 jmp @@e_signature
3491 DB '#$signature$#', 0
3492 DB 'TKOLGradientPanel.SetgradientStyle', 0
3493 @@e_signature:
3494 end;
3495 FgradientStyle := Value;
3496 Invalidate;
3497 Change;
3498 end;
3499
3500 procedure TKOLGradientPanel.SetpopupMenu(const Value: TKOLPopupMenu);
3501 begin
3502 asm
3503 jmp @@e_signature
3504 DB '#$signature$#', 0
3505 DB 'TKOLGradientPanel.SetpopupMenu', 0
3506 @@e_signature:
3507 end;
3508 FpopupMenu := Value;
3509 Change;
3510 end;
3511
3512 procedure TKOLGradientPanel.SetupFirst(SL: TStringList; const AName,
3513 AParent, Prefix: String);
3514 begin
3515 asm
3516 jmp @@e_signature
3517 DB '#$signature$#', 0
3518 DB 'TKOLGradientPanel.SetupFirst', 0
3519 @@e_signature:
3520 end;
3521 inherited;
3522 if GradientStyle = gsHorizontal then
3523 SL.Add( Prefix + AName + '.GradientStyle := gsHorizontal;' );
3524 if HasBorder then
3525 SL.Add( Prefix + AName + '.HasBorder := TRUE;' );
3526 if Assigned( FpopupMenu ) then
3527 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
3528 ' );' );
3529 end;
3530
3531 function TKOLGradientPanel.SetupParams(const AName,
3532 AParent: String): String;
3533 const
3534 GradientLayouts: array[ TGradientLayout ] of String = ( 'glTopLeft',
3535 'glTop', 'glTopRight',
3536 'glLeft', 'glCenter', 'glRight',
3537 'glBottomLeft', 'glBottom', 'glBottomRight' );
3538 GradientStyles: array[ TGradientStyle ] of String = ( 'gsHorizontal',
3539 'gsVertical', 'gsRectangle', 'gsElliptic', 'gsRombic' );
3540 begin
3541 asm
3542 jmp @@e_signature
3543 DB '#$signature$#', 0
3544 DB 'TKOLGradientPanel.SetupParams', 0
3545 @@e_signature:
3546 end;
3547 Result := AParent + ', ' + Color2Str( FColor1 ) + ', ' + Color2Str( FColor2 );
3548 if TypeName <> 'GradientPanel' then
3549 Result := Result + ', ' + GradientStyles[ gradientStyle ] + ', ' +
3550 GradientLayouts[ GradientLayout ];
3551 end;
3552
3553 function TKOLGradientPanel.TabStopByDefault: Boolean;
3554 begin
3555 asm
3556 jmp @@e_signature
3557 DB '#$signature$#', 0
3558 DB 'TKOLGradientPanel.TabStopByDefault', 0
3559 @@e_signature:
3560 end;
3561 Result := TRUE;
3562 end;
3563
3564 function TKOLGradientPanel.TypeName: String;
3565 begin
3566 asm
3567 jmp @@e_signature
3568 DB '#$signature$#', 0
3569 DB 'TKOLGradientPanel.TypeName', 0
3570 @@e_signature:
3571 end;
3572 Result := inherited TypeName;
3573 if not (GradientStyle in [ gsVertical, gsHorizontal ]) or (gradientLayout <> glTop) then
3574 Result := 'GradientPanelEx';
3575 end;
3576
3577 function TKOLGradientPanel.WYSIWIGPaintImplemented: Boolean;
3578 begin
3579 Result := TRUE;
3580 end;
3581
3582 { TKOLGroupBox }
3583
3584 function TKOLGroupBox.ClientMargins: TRect;
3585 begin
3586 asm
3587 jmp @@e_signature
3588 DB '#$signature$#', 0
3589 DB 'TKOLGradientPanel.ClientMargins', 0
3590 @@e_signature:
3591 end;
3592 Result := Rect( 0, 0, 0, 0 );
3593 end;
3594
3595 constructor TKOLGroupBox.Create(AOwner: TComponent);
3596 begin
3597 asm
3598 jmp @@e_signature
3599 DB '#$signature$#', 0
3600 DB 'TKOLGroupBox.Create', 0
3601 @@e_signature:
3602 end;
3603 inherited;
3604 Width := 100; DefaultWidth := Width;
3605 Height := 100; DefaultHeight := 100;
3606 ControlStyle := ControlStyle + [ csAcceptsControls ];
3607 DefaultMarginTop := 22; MarginTop := 22;
3608 DefaultMarginLeft := 2; MarginLeft := 2;
3609 DefaultMarginRight := 2; MarginRight := 2;
3610 DefaultMarginBottom := 2; MarginBottom := 2;
3611 FHasBorder := FALSE; FDefHasBorder := FALSE;
3612 end;
3613
3614 {$IFDEF _KOLCtrlWrapper_} {YS}
3615 procedure TKOLGroupBox.CreateKOLControl(Recreating: boolean);
3616 begin
3617 FKOLCtrl := NewGroupbox(KOLParentCtrl, '');
3618 end;
3619 {$ENDIF}
3620
3621 function TKOLGroupBox.DrawMargins: TRect;
3622 begin
3623 asm
3624 jmp @@e_signature
3625 DB '#$signature$#', 0
3626 DB 'TKOLGroupBox.DrawMargins', 0
3627 @@e_signature:
3628 end;
3629 Result := Rect( 4, 18, 4, 4 );
3630 if Font <> nil then
3631 if Font.FontHeight > 0 then
3632 Result.Top := Font.FontHeight;
3633 end;
3634
3635 procedure TKOLGroupBox.FirstCreate;
3636 begin
3637 asm
3638 jmp @@e_signature
3639 DB '#$signature$#', 0
3640 DB 'TKOLGroupBox.FirstCreate', 0
3641 @@e_signature:
3642 end;
3643 Caption := Name;
3644 inherited;
3645 end;
3646
3647 procedure TKOLGroupBox.SetpopupMenu(const Value: TKOLPopupMenu);
3648 begin
3649 asm
3650 jmp @@e_signature
3651 DB '#$signature$#', 0
3652 DB 'TKOLGroupBox.SetpopupMenu', 0
3653 @@e_signature:
3654 end;
3655 FpopupMenu := Value;
3656 Change;
3657 end;
3658
3659 procedure TKOLGroupBox.SetupFirst(SL: TStringList; const AName, AParent,
3660 Prefix: String);
3661 const
3662 TextAligns: array[ TTextAlign ] of String = ( 'taLeft', 'taRight', 'taCenter' );
3663 begin
3664 asm
3665 jmp @@e_signature
3666 DB '#$signature$#', 0
3667 DB 'TKOLGroupBox.SetupFirst', 0
3668 @@e_signature:
3669 end;
3670 inherited;
3671 if TextAlign <> taLeft then
3672 SL.Add( Prefix + AName + '.TextAlign := ' + TextAligns[ TextAlign ] + ';' );
3673 if Assigned( FpopupMenu ) then
3674 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
3675 ' );' );
3676 end;
3677
3678 function TKOLGroupBox.SetupParams(const AName, AParent: String): String;
3679 begin
3680 asm
3681 jmp @@e_signature
3682 DB '#$signature$#', 0
3683 DB 'TKOLGroupBox.SetupParams', 0
3684 @@e_signature:
3685 end;
3686 Result := AParent + ', ' + StringConstant('Caption',Caption);
3687 end;
3688
3689 function TKOLGroupBox.TabStopByDefault: Boolean;
3690 begin
3691 asm
3692 jmp @@e_signature
3693 DB '#$signature$#', 0
3694 DB 'TKOLGroupBox.TabStopByDefault', 0
3695 @@e_signature:
3696 end;
3697 Result := TRUE;
3698 end;
3699
3700 { TKOLCheckBox }
3701
3702 constructor TKOLCheckBox.Create(AOwner: TComponent);
3703 begin
3704 asm
3705 jmp @@e_signature
3706 DB '#$signature$#', 0
3707 DB 'TKOLCheckBox.Create', 0
3708 @@e_signature:
3709 end;
3710 inherited;
3711 fTabstop := TRUE;
3712 fAutoSzX := 20;
3713 Width := 72; DefaultWidth := Width;
3714 Height := 22; DefaultHeight := 22;
3715 FHasBorder := FALSE;
3716 FDefHasBorder := FALSE;
3717 end;
3718
3719 procedure TKOLCheckBox.CreateKOLControl(Recreating: boolean);
3720 begin
3721 if Auto3State then
3722 FKOLCtrl:=NewCheckBox3State(KOLParentCtrl, '')
3723 else
3724 FKOLCtrl:=NewCheckbox(KOLParentCtrl, '');
3725 end;
3726
3727 procedure TKOLCheckBox.FirstCreate;
3728 begin
3729 asm
3730 jmp @@e_signature
3731 DB '#$signature$#', 0
3732 DB 'TKOLCheckBox.FirstCreate', 0
3733 @@e_signature:
3734 end;
3735 Caption := Name;
3736 inherited;
3737 end;
3738
3739 function TKOLCheckBox.NoDrawFrame: Boolean;
3740 begin
3741 Result := HasBorder;
3742 end;
3743
3744 procedure TKOLCheckBox.Paint;
3745 begin
3746 if not (Assigned(FKOLCtrl) and (PaintType in [ptWYSIWIG, ptWYSIWIGFrames])) then begin
3747 PrepareCanvasFontForWYSIWIGPaint( Canvas );
3748 DrawCheckBox( Self, Canvas );
3749 end;
3750 inherited;
3751 end;
3752
3753 procedure TKOLCheckBox.SetAuto3State(const Value: Boolean);
3754 begin
3755 FAuto3State := Value;
3756 Change;
3757 end;
3758
3759 procedure TKOLCheckBox.SetChecked(const Value: Boolean);
3760 begin
3761 asm
3762 jmp @@e_signature
3763 DB '#$signature$#', 0
3764 DB 'TKOLCheckBox.SetChecked', 0
3765 @@e_signature:
3766 end;
3767 if FChecked = Value then exit;
3768 if action = nil then
3769 FChecked := Value
3770 else
3771 FChecked := action.Checked;
3772 Change;
3773 if Assigned(FKOLCtrl) then
3774 FKOLCtrl.Checked:=FChecked;
3775 Invalidate;
3776 end;
3777
3778 procedure TKOLCheckBox.SetpopupMenu(const Value: TKOLPopupMenu);
3779 begin
3780 asm
3781 jmp @@e_signature
3782 DB '#$signature$#', 0
3783 DB 'TKOLCheckBox.SetpopupMenu', 0
3784 @@e_signature:
3785 end;
3786 FpopupMenu := Value;
3787 Change;
3788 end;
3789
3790 procedure TKOLCheckBox.SetupFirst(SL: TStringList; const AName, AParent,
3791 Prefix: String);
3792 begin
3793 asm
3794 jmp @@e_signature
3795 DB '#$signature$#', 0
3796 DB 'TKOLCheckBox.SetupFirst', 0
3797 @@e_signature:
3798 end;
3799 inherited;
3800 if Checked and (action = nil) then
3801 SL.Add( Prefix + AName + '.Checked := TRUE;' );
3802 if Assigned( FpopupMenu ) then
3803 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
3804 ' );' );
3805 {if WordWrap then
3806 SL.Add( Prefix + AName + '.WordWrap := TRUE;' );}
3807 end;
3808
3809 function TKOLCheckBox.SetupParams(const AName, AParent: String): String;
3810 var
3811 C: string;
3812 begin
3813 asm
3814 jmp @@e_signature
3815 DB '#$signature$#', 0
3816 DB 'TKOLCheckBox.SetupParams', 0
3817 @@e_signature:
3818 end;
3819 if action = nil then
3820 C := StringConstant('Caption',Caption)
3821 else
3822 C := '''''';
3823 Result := AParent + ', ' + C;
3824 end;
3825
3826 function TKOLCheckBox.TabStopByDefault: Boolean;
3827 begin
3828 asm
3829 jmp @@e_signature
3830 DB '#$signature$#', 0
3831 DB 'TKOLCheckBox.TabStopByDefault', 0
3832 @@e_signature:
3833 end;
3834 Result := TRUE;
3835 end;
3836
3837 function TKOLCheckBox.TypeName: String;
3838 begin
3839 if Auto3State and Windowed
3840 then Result := 'CheckBox3State'
3841 else Result := inherited TypeName;
3842 end;
3843
3844 function TKOLCheckBox.WYSIWIGPaintImplemented: Boolean;
3845 begin
3846 Result := TRUE;
3847 end;
3848
3849 { TKOLRadioBox }
3850
3851 constructor TKOLRadioBox.Create(AOwner: TComponent);
3852 begin
3853 asm
3854 jmp @@e_signature
3855 DB '#$signature$#', 0
3856 DB 'TKOLRadioBox.Create', 0
3857 @@e_signature:
3858 end;
3859 inherited;
3860 fTabstop := TRUE;
3861 fAutoSzX := 20;
3862 Width := 72; DefaultWidth := Width;
3863 Height := 22; DefaultHeight := 22;
3864 FHasBorder := FALSE;
3865 FDefHasBorder := FALSE;
3866 end;
3867
3868 procedure TKOLRadioBox.FirstCreate;
3869 begin
3870 asm
3871 jmp @@e_signature
3872 DB '#$signature$#', 0
3873 DB 'TKOLRadioBox.FirstCreate', 0
3874 @@e_signature:
3875 end;
3876 Caption := Name;
3877 inherited;
3878 end;
3879
3880 function TKOLRadioBox.NoDrawFrame: Boolean;
3881 begin
3882 Result := HasBorder;
3883 end;
3884
3885 procedure TKOLRadioBox.Paint;
3886 begin
3887 PrepareCanvasFontForWYSIWIGPaint( Canvas );
3888 DrawRadioBox( Self, Canvas );
3889 inherited;
3890 end;
3891
3892 procedure TKOLRadioBox.SetChecked(const Value: Boolean);
3893 var I: Integer;
3894 C: TComponent;
3895 K: TKOLCustomControl;
3896 begin
3897 asm
3898 jmp @@e_signature
3899 DB '#$signature$#', 0
3900 DB 'TKOLRadioBox.SetChecked', 0
3901 @@e_signature:
3902 end;
3903 if FChecked = Value then exit;
3904 if action = nil then
3905 FChecked := Value
3906 else
3907 FChecked := action.Checked;
3908 Change;
3909 if FChecked then
3910 if Parent <> nil then
3911 begin
3912 for I := 0 to ParentForm.ComponentCount - 1 do
3913 begin
3914 C := ParentForm.Components[ I ];
3915 if C <> Self then
3916 if C is TKOLCustomControl then
3917 begin
3918 K := C as TKOLCustomControl;
3919 if K.Parent = Parent then
3920 if K is TKOLRadioBox then
3921 (K as TKOLRadioBox).Checked := FALSE;
3922 end;
3923 end;
3924 end;
3925 end;
3926
3927 procedure TKOLRadioBox.SetpopupMenu(const Value: TKOLPopupMenu);
3928 begin
3929 asm
3930 jmp @@e_signature
3931 DB '#$signature$#', 0
3932 DB 'TKOLRadioBox.SetpopupMenu', 0
3933 @@e_signature:
3934 end;
3935 FpopupMenu := Value;
3936 Change;
3937 end;
3938
3939 procedure TKOLRadioBox.SetupFirst(SL: TStringList; const AName, AParent,
3940 Prefix: String);
3941 begin
3942 asm
3943 jmp @@e_signature
3944 DB '#$signature$#', 0
3945 DB 'TKOLRadioBox.SetupFirst', 0
3946 @@e_signature:
3947 end;
3948 inherited;
3949 if Checked and (action = nil) then
3950 SL.add( Prefix + AName + '.SetRadioChecked;' );
3951 if Assigned( FpopupMenu ) then
3952 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
3953 ' );' );
3954 {if WordWrap then
3955 SL.Add( Prefix + AName + '.WordWrap := TRUE;' );}
3956 end;
3957
3958 function TKOLRadioBox.SetupParams(const AName, AParent: String): String;
3959 var
3960 C: string;
3961 begin
3962 asm
3963 jmp @@e_signature
3964 DB '#$signature$#', 0
3965 DB 'TKOLRadioBox.SetupParams', 0
3966 @@e_signature:
3967 end;
3968 if action = nil then
3969 C := StringConstant('Caption',Caption)
3970 else
3971 C := '''''';
3972 Result := AParent + ', ' + C;
3973 end;
3974
3975 function TKOLRadioBox.TabStopByDefault: Boolean;
3976 begin
3977 asm
3978 jmp @@e_signature
3979 DB '#$signature$#', 0
3980 DB 'TKOLRadioBox.TabStopByDefault', 0
3981 @@e_signature:
3982 end;
3983 Result := TRUE;
3984 end;
3985
3986 function TKOLRadioBox.WYSIWIGPaintImplemented: Boolean;
3987 begin
3988 Result := TRUE;
3989 end;
3990
3991 { TKOLEditBox }
3992
3993 function TKOLEditBox.BestEventName: String;
3994 begin
3995 Result := 'OnChange';
3996 end;
3997
3998 constructor TKOLEditBox.Create(AOwner: TComponent);
3999 begin
4000 asm
4001 jmp @@e_signature
4002 DB '#$signature$#', 0
4003 DB 'TKOLEditBox.Create', 0
4004 @@e_signature:
4005 end;
4006 inherited;
4007 fNoAutoSizeX := TRUE;
4008 fAutoSzY := 6;
4009 Width := 100; DefaultWidth := Width;
4010 Height := 22; DefaultHeight := 22;
4011 TabStop := TRUE;
4012 FResetTabStopByStyle := TRUE;
4013 end;
4014
4015 function TKOLEditBox.DefaultColor: TColor;
4016 begin
4017 asm
4018 jmp @@e_signature
4019 DB '#$signature$#', 0
4020 DB 'TKOLEditBox.DefaultColor', 0
4021 @@e_signature:
4022 end;
4023 Result := clWindow;
4024 end;
4025
4026 procedure TKOLEditBox.FirstCreate;
4027 begin
4028 asm
4029 jmp @@e_signature
4030 DB '#$signature$#', 0
4031 DB 'TKOLEditBox.FirstCreate', 0
4032 @@e_signature:
4033 end;
4034 Text := Name;
4035 inherited;
4036 end;
4037
4038 function TKOLEditBox.GetCaption: String;
4039 begin
4040 asm
4041 jmp @@e_signature
4042 DB '#$signature$#', 0
4043 DB 'TKOLEditBox.GetCaption', 0
4044 @@e_signature:
4045 end;
4046 Result := inherited Caption;
4047 end;
4048
4049 function TKOLEditBox.GetText: String;
4050 begin
4051 asm
4052 jmp @@e_signature
4053 DB '#$signature$#', 0
4054 DB 'TKOLEditBox.GetText', 0
4055 @@e_signature:
4056 end;
4057 Result := Caption;
4058 end;
4059
4060 function TKOLEditBox.NoDrawFrame: Boolean;
4061 begin
4062 asm
4063 jmp @@e_signature
4064 DB '#$signature$#', 0
4065 DB 'TKOLEditBox.NoDrawFrame', 0
4066 @@e_signature:
4067 end;
4068 Result := HasBorder;
4069 end;
4070
4071 procedure TKOLEditBox.Paint;
4072 var
4073 R:TRect;
4074 Flag:DWord;
4075 Delta: Integer;
4076 begin
4077 asm
4078 jmp @@e_signature
4079 DB '#$signature$#', 0
4080 DB 'TKOLEditBox.Paint', 0
4081 @@e_signature:
4082 end;
4083
4084 PrepareCanvasFontForWYSIWIGPaint( Canvas );
4085
4086 R.Left:=0;
4087 R.Top:=0;
4088 R.Right:=Width;
4089 R.Bottom:=Height;
4090
4091 if HasBorder then
4092 begin
4093 if Ctl3D then
4094 begin
4095 DrawEdge(Canvas.Handle,R,EDGE_SUNKEN,BF_RECT);
4096 Delta := 3;
4097 end
4098 else
4099 begin
4100 Canvas.Brush.Color := clWindowText;
4101 Canvas.FrameRect(R);
4102 Delta := 2;
4103 end;
4104
4105 R.Left:=Delta;
4106 R.Top:=Delta;
4107 R.Right:=Width-Delta;
4108 R.Bottom:=Height-Delta;
4109 end;
4110
4111 Flag:=0;
4112 case TextAlign of
4113 taRight: Flag:=Flag or DT_RIGHT;
4114 taLeft: Flag:=Flag or DT_LEFT;
4115 taCenter: Flag:=Flag or DT_CENTER;
4116 end;
4117
4118 Canvas.Brush.Color := Color;
4119 DrawText(Canvas.Handle,PChar(Caption),Length(Caption),R,Flag);
4120
4121 inherited;
4122
4123 end;
4124
4125 procedure TKOLEditBox.SetEdTransparent(const Value: Boolean);
4126 begin
4127 asm
4128 jmp @@e_signature
4129 DB '#$signature$#', 0
4130 DB 'TKOLEditBox.SetEdTransparent', 0
4131 @@e_signature:
4132 end;
4133 FEdTransparent := Value;
4134 Change;
4135 end;
4136
4137 procedure TKOLEditBox.SetOptions(const Value: TKOLEditOptions);
4138 begin
4139 asm
4140 jmp @@e_signature
4141 DB '#$signature$#', 0
4142 DB 'TKOLEditBox.SetOptions', 0
4143 @@e_signature:
4144 end;
4145 FOptions := Value;
4146 Change;
4147 end;
4148
4149 procedure TKOLEditBox.SetpopupMenu(const Value: TKOLPopupMenu);
4150 begin
4151 asm
4152 jmp @@e_signature
4153 DB '#$signature$#', 0
4154 DB 'TKOLEditBox.SetpopupMenu', 0
4155 @@e_signature:
4156 end;
4157 FpopupMenu := Value;
4158 Change;
4159 end;
4160
4161 procedure TKOLEditBox.SetText(const Value: String);
4162 begin
4163 asm
4164 jmp @@e_signature
4165 DB '#$signature$#', 0
4166 DB 'TKOLEditBox.SetText', 0
4167 @@e_signature:
4168 end;
4169 SetCaption( Value );
4170 end;
4171
4172 procedure TKOLEditBox.SetupFirst(SL: TStringList; const AName,
4173 AParent, Prefix: String);
4174 const
4175 Aligns: array[ TTextAlign ] of String = ( 'taLeft', 'taRight', 'taCenter' );
4176 begin
4177 asm
4178 jmp @@e_signature
4179 DB '#$signature$#', 0
4180 DB 'TKOLEditBox.SetupFirst', 0
4181 @@e_signature:
4182 end;
4183 inherited;
4184 if Text <> '' then
4185 AddLongTextField( SL, Prefix + AName + '.Text := ', Text, ';' );
4186 if TextAlign <> taLeft then
4187 SL.Add( Prefix + AName + '.TextAlign := ' + Aligns[ TextAlign ] + ';' );
4188 if Transparent then
4189 SL.Add( Prefix + AName + '.Ed_Transparent := TRUE;' );
4190 if Assigned( FpopupMenu ) then
4191 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
4192 ' );' );
4193 end;
4194
4195 function TKOLEditBox.SetupParams(const AName, AParent: String): String;
4196 var S: String;
4197 begin
4198 asm
4199 jmp @@e_signature
4200 DB '#$signature$#', 0
4201 DB 'TKOLEditBox.SetupParams', 0
4202 @@e_signature:
4203 end;
4204 S := '';
4205 if eoLowercase in Options then
4206 S := S + ', eoLowercase';
4207 if eoNoHideSel in Options then
4208 S := S + ', eoNoHideSel';
4209 if eoOemConvert in Options then
4210 S := S + ', eoOemConvert';
4211 if eoPassword in Options then
4212 S := S + ', eoPassword';
4213 if eoReadonly in Options then
4214 S := S + ', eoReadonly';
4215 if eoUpperCase in Options then
4216 S := S + ', eoUpperCase';
4217 if eoWantTab in Options then
4218 S := S + ', eoWantTab';
4219 if eoNumber in Options then
4220 S := S + ', eoNumber';
4221 if S <> '' then
4222 if S[ 1 ] = ',' then
4223 S := Copy( S, 3, MaxInt );
4224 Result := AParent + ', [ ' + S + ' ]';
4225 end;
4226
4227 procedure TKOLEditBox.SetupTextAlign(SL: TStrings; const AName: String);
4228 begin
4229 inherited;
4230 if TextAlign <> taLeft then
4231 SL.Add(' ' + AName + '.TextAlign := ' + TextAligns[TextAlign] + ';');
4232 end;
4233
4234 function TKOLEditBox.TabStopByDefault: Boolean;
4235 begin
4236 asm
4237 jmp @@e_signature
4238 DB '#$signature$#', 0
4239 DB 'TKOLEditBox.TabStopByDefault', 0
4240 @@e_signature:
4241 end;
4242 Result := TRUE;
4243 end;
4244
4245 procedure TKOLEditBox.WantTabs( Want: Boolean );
4246 begin
4247 asm
4248 jmp @@e_signature
4249 DB '#$signature$#', 0
4250 DB 'TKOLEditBox.WantTabs', 0
4251 @@e_signature:
4252 end;
4253 if Want then
4254 Options := Options + [ eoWantTab ]
4255 else
4256 Options := Options - [ eoWantTab ];
4257 end;
4258
4259 function TKOLEditBox.WYSIWIGPaintImplemented: Boolean;
4260 begin
4261 asm
4262 jmp @@e_signature
4263 DB '#$signature$#', 0
4264 DB 'TKOLEditBox.WYSIWIGPaintImplemented', 0
4265 @@e_signature:
4266 end;
4267 Result := TRUE;
4268 end;
4269
4270 { TKOLMemo }
4271
4272 function TKOLMemo.BestEventName: String;
4273 begin
4274 Result := 'OnChange';
4275 end;
4276
4277 constructor TKOLMemo.Create(AOwner: TComponent);
4278 begin
4279 asm
4280 jmp @@e_signature
4281 DB '#$signature$#', 0
4282 DB 'TKOLMemo.Create', 0
4283 @@e_signature:
4284 end;
4285 FLines := TStringList.Create;
4286 inherited;
4287 FDefIgnoreDefault := TRUE;
4288 FIgnoreDefault := TRUE;
4289 Width := 200; DefaultWidth := Width;
4290 Height := 222; DefaultHeight := Height;
4291 TabStop := TRUE;
4292 end;
4293
4294 procedure TKOLMemo.CreateKOLControl(Recreating: boolean);
4295 var
4296 opts: kol.TEditOptions;
4297 begin
4298 opts:=[eoMultiline];
4299 if eo_Lowercase in FOptions then
4300 Include(opts, kol.eoLowercase);
4301 if eo_NoHScroll in FOptions then
4302 Include(opts, kol.eoNoHScroll);
4303 if eo_NoVScroll in FOptions then
4304 Include(opts, kol.eoNoVScroll);
4305 if eo_UpperCase in FOptions then
4306 Include(opts, kol.eoUpperCase);
4307 FKOLCtrl:=NewEditbox(KOLParentCtrl, opts);
4308 if Recreating then
4309 FKOLCtrl.TextAlign:=kol.TTextAlign(TextAlign);
4310 end;
4311
4312 function TKOLMemo.DefaultColor: TColor;
4313 begin
4314 asm
4315 jmp @@e_signature
4316 DB '#$signature$#', 0
4317 DB 'TKOLMemo.DefaultColor', 0
4318 @@e_signature:
4319 end;
4320 Result := clWindow;
4321 end;
4322
4323 destructor TKOLMemo.Destroy;
4324 begin
4325 asm
4326 jmp @@e_signature
4327 DB '#$signature$#', 0
4328 DB 'TKOLMemo.Destroy', 0
4329 @@e_signature:
4330 end;
4331 FLines.Free;
4332 inherited;
4333 end;
4334
4335 procedure TKOLMemo.FirstCreate;
4336 begin
4337 asm
4338 jmp @@e_signature
4339 DB '#$signature$#', 0
4340 DB 'TKOLMemo.FirstCreate', 0
4341 @@e_signature:
4342 end;
4343 FLines.Text := Name;
4344 if Assigned(FKOLCtrl) then
4345 FKOLCtrl.Text:=FLines.Text;
4346 inherited;
4347 end;
4348
4349 function TKOLMemo.GetCaption: String;
4350 begin
4351 asm
4352 jmp @@e_signature
4353 DB '#$signature$#', 0
4354 DB 'TKOLMemo.GetCaption', 0
4355 @@e_signature:
4356 end;
4357 Result := inherited Caption;
4358 end;
4359
4360 function TKOLMemo.GetText: TStrings;
4361 begin
4362 asm
4363 jmp @@e_signature
4364 DB '#$signature$#', 0
4365 DB 'TKOLMemo.GetText', 0
4366 @@e_signature:
4367 end;
4368 Result := FLines;
4369 end;
4370
4371 procedure TKOLMemo.KOLControlRecreated;
4372 begin
4373 inherited;
4374 FKOLCtrl.Text:=FLines.Text;
4375 end;
4376
4377 procedure TKOLMemo.Loaded;
4378 begin
4379 inherited;
4380 if Assigned(FKOLCtrl) then
4381 FKOLCtrl.Text:=FLines.Text;
4382 end;
4383
4384 function TKOLMemo.NoDrawFrame: Boolean;
4385 begin
4386 Result := HasBorder;
4387 end;
4388
4389 procedure TKOLMemo.SetEdTransparent(const Value: Boolean);
4390 begin
4391 asm
4392 jmp @@e_signature
4393 DB '#$signature$#', 0
4394 DB 'TKOLMemo.SetEdTransparent', 0
4395 @@e_signature:
4396 end;
4397 FEdTransparent := Value;
4398 Change;
4399 end;
4400
4401 procedure TKOLMemo.SetOptions(const Value: TKOLMemoOptions);
4402 begin
4403 asm
4404 jmp @@e_signature
4405 DB '#$signature$#', 0
4406 DB 'TKOLMemo.SetOptions', 0
4407 @@e_signature:
4408 end;
4409 FOptions := Value;
4410 if Assigned(FKOLCtrl) then
4411 RecreateWnd;
4412 Change;
4413 end;
4414
4415 procedure TKOLMemo.SetpopupMenu(const Value: TKOLPopupMenu);
4416 begin
4417 asm
4418 jmp @@e_signature
4419 DB '#$signature$#', 0
4420 DB 'TKOLMemo.SetpopupMenu', 0
4421 @@e_signature:
4422 end;
4423 FpopupMenu := Value;
4424 Change;
4425 end;
4426
4427 procedure TKOLMemo.SetText(const Value: TStrings);
4428 begin
4429 asm
4430 jmp @@e_signature
4431 DB '#$signature$#', 0
4432 DB 'TKOLMemo.SetText', 0
4433 @@e_signature:
4434 end;
4435 FLines.Text := Value.Text;
4436 if Assigned(FKOLCtrl) then
4437 FKOLCtrl.Text:=Value.Text;
4438 Change;
4439 end;
4440
4441 procedure TKOLMemo.SetTextAlign(const Value: TTextAlign);
4442 begin
4443 inherited;
4444 if Assigned(FKOLCtrl) then
4445 RecreateWnd;
4446 end;
4447
4448 procedure TKOLMemo.SetupFirst(SL: TStringList; const AName,
4449 AParent, Prefix: String);
4450 begin
4451 asm
4452 jmp @@e_signature
4453 DB '#$signature$#', 0
4454 DB 'TKOLMemo.SetupFirst', 0
4455 @@e_signature:
4456 end;
4457 inherited;
4458 if TextAlign <> taLeft then
4459 SL.Add( Prefix + AName + '.TextAlign := ' + TextAligns[ TextAlign ] + ';' );
4460 if FLines.Text <> '' then
4461 AddLongTextField( SL, Prefix + AName + '.Text := ', FLines.Text, ';' );
4462 if Transparent then
4463 SL.Add( Prefix + AName + '.Ed_Transparent := TRUE;' );
4464 if Assigned( FpopupMenu ) then
4465 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
4466 ' );' );
4467 end;
4468
4469 function TKOLMemo.SetupParams(const AName, AParent: String): String;
4470 var S: String;
4471 begin
4472 asm
4473 jmp @@e_signature
4474 DB '#$signature$#', 0
4475 DB 'TKOLMemo.SetupParams', 0
4476 @@e_signature:
4477 end;
4478 S := 'eoMultiline';
4479 if eo_NoHScroll in Options then
4480 S := S + ', eoNoHScroll';
4481 if eo_NoVScroll in Options then
4482 S := S + ', eoNoVScroll';
4483 if eo_Lowercase in Options then
4484 S := S + ', eoLowercase';
4485 if eo_NoHideSel in Options then
4486 S := S + ', eoNoHideSel';
4487 if eo_OemConvert in Options then
4488 S := S + ', eoOemConvert';
4489 if eo_Password in Options then
4490 S := S + ', eoPassword';
4491 if eo_Readonly in Options then
4492 S := S + ', eoReadonly';
4493 if eo_UpperCase in Options then
4494 S := S + ', eoUpperCase';
4495 if eo_WantReturn in Options then
4496 S := S + ', eoWantReturn';
4497 if eo_WantTab in Options then
4498 S := S + ', eoWantTab';
4499 if S <> '' then
4500 if S[ 1 ] = ',' then
4501 S := Copy( S, 3, MaxInt );
4502 Result := AParent + ', [ ' + S + ' ]';
4503 end;
4504
4505 procedure TKOLMemo.SetupTextAlign(SL: TStrings; const AName: String);
4506 begin
4507 inherited;
4508 if TextAlign <> taLeft then
4509 SL.Add(' ' + AName + '.TextAlign := ' + TextAligns[TextAlign] + ';');
4510 end;
4511
4512 function TKOLMemo.TabStopByDefault: Boolean;
4513 begin
4514 asm
4515 jmp @@e_signature
4516 DB '#$signature$#', 0
4517 DB 'TKOLMemo.TabStopByDefault', 0
4518 @@e_signature:
4519 end;
4520 Result := TRUE;
4521 end;
4522
4523 function TKOLMemo.TypeName: String;
4524 begin
4525 asm
4526 jmp @@e_signature
4527 DB '#$signature$#', 0
4528 DB 'TKOLMemo.TypeName', 0
4529 @@e_signature:
4530 end;
4531 Result := 'EditBox';
4532 end;
4533
4534 procedure TKOLMemo.WantTabs( Want: Boolean );
4535 begin
4536 asm
4537 jmp @@e_signature
4538 DB '#$signature$#', 0
4539 DB 'TKOLMemo.WantTabs', 0
4540 @@e_signature:
4541 end;
4542 if Want then
4543 Options := Options + [ eo_WantTab ]
4544 else
4545 Options := Options - [ eo_WantTab ];
4546 end;
4547
4548 { TKOLListBox }
4549
4550 constructor TKOLListBox.Create(AOwner: TComponent);
4551 begin
4552 asm
4553 jmp @@e_signature
4554 DB '#$signature$#', 0
4555 DB 'TKOLListBox.Create', 0
4556 @@e_signature:
4557 end;
4558 FItems := TStringList.Create;
4559 inherited;
4560 Width := 164; DefaultWidth := Width;
4561 Height := 200; DefaultHeight := Height;
4562 TabStop := TRUE;
4563 Options := [ loNoIntegralHeight ];
4564 end;
4565
4566 procedure TKOLListBox.CreateKOLControl(Recreating: boolean);
4567 var
4568 opts: kol.TListOptions;
4569 begin
4570 opts:=[];
4571 if loNoHideScroll in FOptions then
4572 Include(opts, kol.loNoHideScroll);
4573 if loMultiColumn in FOptions then
4574 Include(opts, kol.loMultiColumn);
4575 FKOLCtrl:=NewListbox(KOLParentCtrl, opts + [kol.loNoIntegralHeight]);
4576 end;
4577
4578 function TKOLListBox.DefaultColor: TColor;
4579 begin
4580 asm
4581 jmp @@e_signature
4582 DB '#$signature$#', 0
4583 DB 'TKOLListBox.DefaultColor', 0
4584 @@e_signature:
4585 end;
4586 Result := clWindow;
4587 end;
4588
4589 destructor TKOLListBox.Destroy;
4590 begin
4591 asm
4592 jmp @@e_signature
4593 DB '#$signature$#', 0
4594 DB 'TKOLListBox.Destroy', 0
4595 @@e_signature:
4596 end;
4597 inherited;
4598 FItems.Free;
4599 end;
4600
4601 procedure TKOLListBox.FirstCreate;
4602 begin
4603 asm
4604 jmp @@e_signature
4605 DB '#$signature$#', 0
4606 DB 'TKOLListBox.FirstCreate', 0
4607 @@e_signature:
4608 end;
4609 //FItems.Text := Name;
4610 FCurIndex := 0;
4611 inherited;
4612 end;
4613
4614 { +ecm }
4615 function TKOLListBox.GenerateTransparentInits: String;
4616 begin
4617 if fLBItemHeight > 0 then Result := '.SetLVItemHeight('+IntToStr(fLBItemHeight)+')'
4618 else Result := '';
4619 Result := Result + inherited GenerateTransparentInits();
4620 end;
4621 { /+ecm }
4622
4623 function TKOLListBox.GetCaption: String;
4624 begin
4625 asm
4626 jmp @@e_signature
4627 DB '#$signature$#', 0
4628 DB 'TKOLListBox.GetCaption', 0
4629 @@e_signature:
4630 end;
4631 Result := inherited Caption;
4632 end;
4633
4634 procedure TKOLListBox.KOLControlRecreated;
4635 begin
4636 inherited;
4637 UpdateItems;
4638 end;
4639
4640 procedure TKOLListBox.Loaded;
4641 begin
4642 inherited;
4643 UpdateItems;
4644 end;
4645
4646 function TKOLListBox.NoDrawFrame: Boolean;
4647 begin
4648 Result:=HasBorder;
4649 end;
4650
4651 procedure TKOLListBox.SetCount(Value: Integer);
4652 begin
4653 asm
4654 jmp @@e_signature
4655 DB '#$signature$#', 0
4656 DB 'TKOLListBox.SetCount', 0
4657 @@e_signature:
4658 end;
4659 if Value < 0 then
4660 Value := 0;
4661 FCount := Value;
4662 Change;
4663 end;
4664
4665 procedure TKOLListBox.SetCurIndex(const Value: Integer);
4666 begin
4667 asm
4668 jmp @@e_signature
4669 DB '#$signature$#', 0
4670 DB 'TKOLListBox.SetCurIndex', 0
4671 @@e_signature:
4672 end;
4673 FCurIndex := Value;
4674 Change;
4675 end;
4676
4677 procedure TKOLListBox.SetItems(const Value: TStrings);
4678 begin
4679 asm
4680 jmp @@e_signature
4681 DB '#$signature$#', 0
4682 DB 'TKOLListBox.SetItems', 0
4683 @@e_signature:
4684 end;
4685 FItems.Text := Value.Text;
4686 UpdateItems;
4687 Change;
4688 end;
4689
4690 { +ecm }
4691 procedure TKOLListBox.SetLBItemHeight(const Value: Integer);
4692 begin
4693 if fLBItemHeight <> Value then begin
4694 fLBItemHeight := Value;
4695 Change;
4696 end;
4697 end;
4698 { /+ecm }
4699
4700 procedure TKOLListBox.SetOptions(const Value: TKOLListboxOptions);
4701 begin
4702 asm
4703 jmp @@e_signature
4704 DB '#$signature$#', 0
4705 DB 'TKOLListBox.SetOptions', 0
4706 @@e_signature:
4707 end;
4708 FOptions := Value;
4709 if Assigned(FKOLCtrl) then
4710 RecreateWnd;
4711 Change;
4712 end;
4713
4714 procedure TKOLListBox.SetpopupMenu(const Value: TKOLPopupMenu);
4715 begin
4716 asm
4717 jmp @@e_signature
4718 DB '#$signature$#', 0
4719 DB 'TKOLListBox.SetpopupMenu', 0
4720 @@e_signature:
4721 end;
4722 FpopupMenu := Value;
4723 Change;
4724 end;
4725
4726 procedure TKOLListBox.SetupFirst(SL: TStringList; const AName,
4727 AParent, Prefix: String);
4728 var I: Integer;
4729 begin
4730 asm
4731 jmp @@e_signature
4732 DB '#$signature$#', 0
4733 DB 'TKOLListBox.SetupFirst', 0
4734 @@e_signature:
4735 end;
4736 inherited;
4737 if FItems.Text <> '' then
4738 begin
4739 for I := 0 to FItems.Count - 1 do
4740 SL.Add( Prefix + AName + '.Items[ ' + Int2Str( I ) + ' ] := ' +
4741 StringConstant( 'Item' + IntToStr( I ), FItems[ I ] ) + ';' );
4742 end;
4743 if FCurIndex >= 0 then
4744 SL.Add( Prefix + AName + '.CurIndex := ' + Int2Str( FCurIndex ) + ';' );
4745 if Assigned( FpopupMenu ) then
4746 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
4747 ' );' );
4748 end;
4749
4750 procedure TKOLListBox.SetupLast(SL: TStringList; const AName, AParent,
4751 Prefix: String);
4752 begin
4753 asm
4754 jmp @@e_signature
4755 DB '#$signature$#', 0
4756 DB 'TKOLListBox.SetupLast', 0
4757 @@e_signature:
4758 end;
4759 inherited;
4760 if loNoData in Options then
4761 if Count > 0 then
4762 SL.Add( Prefix + AName + '.Count := ' + IntToStr( Count ) + ';' );
4763 end;
4764
4765 function TKOLListBox.SetupParams(const AName, AParent: String): String;
4766 var S: String;
4767 begin
4768 asm
4769 jmp @@e_signature
4770 DB '#$signature$#', 0
4771 DB 'TKOLListBox.SetupParams', 0
4772 @@e_signature:
4773 end;
4774 if loNoHideScroll in Options then
4775 S := S + 'loNoHideScroll';
4776 if loNoExtendSel in Options then
4777 S := S + ', loNoExtendSel';
4778 if loMultiColumn in Options then
4779 S := S + ', loMultiColumn';
4780 if loMultiSelect in Options then
4781 S := S + ', loMultiSelect';
4782 if loNoIntegralHeight in Options then
4783 S := S + ', loNoIntegralHeight';
4784 if loNoSel in Options then
4785 S := S + ', loNoSel';
4786 if loSort in Options then
4787 S := S + ', loSort';
4788 if loTabstops in Options then
4789 S := S + ', loTabstops';
4790 if loNoStrings in Options then
4791 S := S + ', loNoStrings';
4792 if loNoData in Options then
4793 S := S + ', loNoData';
4794 if loOwnerDrawFixed in Options then
4795 S := S + ', loOwnerDrawFixed';
4796 if loOwnerDrawVariable in Options then
4797 S := S + ', loOwnerDrawVariable';
4798 if S <> '' then
4799 if S[ 1 ] = ',' then
4800 S := Copy( S, 3, MaxInt );
4801 Result := AParent + ', [ ' + S + ' ]';
4802 end;
4803
4804 function TKOLListBox.TabStopByDefault: Boolean;
4805 begin
4806 asm
4807 jmp @@e_signature
4808 DB '#$signature$#', 0
4809 DB 'TKOLListBox.TabStopByDefault', 0
4810 @@e_signature:
4811 end;
4812 Result := TRUE;
4813 end;
4814
4815 procedure TKOLListBox.UpdateItems;
4816 var
4817 i: integer;
4818 begin
4819 if Assigned(FKOLCtrl) then begin
4820 FKOLCtrl.BeginUpdate;
4821 try
4822 FKOLCtrl.Clear;
4823 if [loOwnerDrawFixed, loOwnerDrawVariable] * FOptions = [] then
4824 for i:=0 to FItems.Count - 1 do
4825 FKOLCtrl.Items[i]:=FItems[i];
4826 finally
4827 FKOLCtrl.EndUpdate;
4828 end;
4829 end;
4830 end;
4831
4832 { TKOLComboBox }
4833
4834 function TKOLComboBox.AutoHeight(Canvas: TCanvas): Integer;
4835 begin
4836 if coSimple in Options then
4837 Result := Height
4838 else
4839 Result := inherited AutoHeight( Canvas );
4840 end;
4841
4842 function TKOLComboBox.AutoSizeRunTime: Boolean;
4843 begin
4844 Result := not( coSimple in Options );
4845 end;
4846
4847 constructor TKOLComboBox.Create(AOwner: TComponent);
4848 begin
4849 asm
4850 jmp @@e_signature
4851 DB '#$signature$#', 0
4852 DB 'TKOLComboBox.Create', 0
4853 @@e_signature:
4854 end;
4855 FItems := TStringList.Create;
4856 inherited;
4857 fNoAutoSizeX := TRUE;
4858 fAutoSzY := 6;
4859 Width := 100; DefaultWidth := Width;
4860 Height := 22; DefaultHeight := Height;
4861 TabStop := TRUE;
4862 Options := [ coNoIntegralHeight ];
4863 end;
4864
4865 function TKOLComboBox.DefaultColor: TColor;
4866 begin
4867 asm
4868 jmp @@e_signature
4869 DB '#$signature$#', 0
4870 DB 'TKOLComboBox.DefaultColor', 0
4871 @@e_signature:
4872 end;
4873 Result := clWhite; // !!! in Windows, default color for combobox really is clWhite
4874 end;
4875
4876 function TKOLComboBox.DefaultInitialColor: TColor;
4877 begin
4878 asm
4879 jmp @@e_signature
4880 DB '#$signature$#', 0
4881 DB 'TKOLComboBox.DefaultInitialColor', 0
4882 @@e_signature:
4883 end;
4884 Result := clWindow;
4885 end;
4886
4887 destructor TKOLComboBox.Destroy;
4888 begin
4889 asm
4890 jmp @@e_signature
4891 DB '#$signature$#', 0
4892 DB 'TKOLComboBox.Destroy', 0
4893 @@e_signature:
4894 end;
4895 inherited;
4896 FItems.Free;
4897 end;
4898
4899 procedure TKOLComboBox.FirstCreate;
4900 begin
4901 asm
4902 jmp @@e_signature
4903 DB '#$signature$#', 0
4904 DB 'TKOLComboBox.FirstCreate', 0
4905 @@e_signature:
4906 end;
4907 FItems.Text := Name;
4908 FCurIndex := 0;
4909 inherited;
4910 end;
4911
4912 function TKOLComboBox.GenerateTransparentInits: String;
4913 begin
4914 if fCBItemHeight > 0 then Result := '.SetLVItemHeight('+IntToStr(fCBItemHeight)+')'
4915 else Result := '';
4916 Result := Result + inherited GenerateTransparentInits();
4917 end;
4918
4919 function TKOLComboBox.NoDrawFrame: Boolean;
4920 begin
4921 Result := HasBorder;
4922 end;
4923
4924 procedure TKOLComboBox.Paint;
4925 begin
4926 if not (Assigned(FKOLCtrl) and (PaintType in [ptWYSIWIG, ptWYSIWIGFrames])) then begin
4927 PrepareCanvasFontForWYSIWIGPaint( Canvas );
4928 DrawCombobox( Self, Canvas );
4929 end;
4930 inherited;
4931 end;
4932
4933 procedure TKOLComboBox.SetCBItemHeight(const Value: Integer);
4934 begin
4935 if fCBItemHeight <> Value then
4936 begin
4937 fCBItemHeight := Value;
4938 Change;
4939 end;
4940 end;
4941
4942 procedure TKOLComboBox.SetCurIndex(const Value: Integer);
4943 begin
4944 asm
4945 jmp @@e_signature
4946 DB '#$signature$#', 0
4947 DB 'TKOLComboBox.SetCurIndex', 0
4948 @@e_signature:
4949 end;
4950 FCurIndex := Value;
4951 Change;
4952 end;
4953
4954 procedure TKOLComboBox.SetDroppedWidth(const Value: Integer);
4955 begin
4956 asm
4957 jmp @@e_signature
4958 DB '#$signature$#', 0
4959 DB 'TKOLComboBox.SetDroppedWidth', 0
4960 @@e_signature:
4961 end;
4962 FDroppedWidth := Value;
4963 Change;
4964 end;
4965
4966 procedure TKOLComboBox.SetItems(const Value: TStrings);
4967 begin
4968 asm
4969 jmp @@e_signature
4970 DB '#$signature$#', 0
4971 DB 'TKOLComboBox.SetItems', 0
4972 @@e_signature:
4973 end;
4974 FItems.Text := Value.Text;
4975 Change;
4976 end;
4977
4978 procedure TKOLComboBox.SetOptions(const Value: TKOLComboOptions);
4979 begin
4980 asm
4981 jmp @@e_signature
4982 DB '#$signature$#', 0
4983 DB 'TKOLComboBox.SetOptions', 0
4984 @@e_signature:
4985 end;
4986 FOptions := Value;
4987 Change;
4988 if AutoSize then
4989 AutoSizeNow;
4990 Invalidate;
4991 end;
4992
4993 procedure TKOLComboBox.SetpopupMenu(const Value: TKOLPopupMenu);
4994 begin
4995 asm
4996 jmp @@e_signature
4997 DB '#$signature$#', 0
4998 DB 'TKOLComboBox.SetpopupMenu', 0
4999 @@e_signature:
5000 end;
5001 FpopupMenu := Value;
5002 Change;
5003 end;
5004
5005 procedure TKOLComboBox.SetupFirst(SL: TStringList; const AName, AParent,
5006 Prefix: String);
5007 var I: Integer;
5008 begin
5009 asm
5010 jmp @@e_signature
5011 DB '#$signature$#', 0
5012 DB 'TKOLComboBox.SetupFirst', 0
5013 @@e_signature:
5014 end;
5015 inherited;
5016 if FItems.Text <> '' then
5017 begin
5018 for I := 0 to FItems.Count - 1 do
5019 SL.Add( Prefix + AName + '.Items[ ' + Int2Str( I ) + ' ] := ' +
5020 StringConstant( 'Item' + IntToStr( I ), FItems[ I ] ) + ';' );
5021 end;
5022 if FCurIndex >= 0 then
5023 SL.Add( Prefix + AName + '.CurIndex := ' + Int2Str( FCurIndex ) + ';' );
5024 if (FDroppedWidth <> Width) and (FDroppedWidth <> 0) then
5025 SL.Add( Prefix + AName + '.DroppedWidth := ' + Int2Str( FDroppedWidth ) + ';' );
5026 if Assigned( FpopupMenu ) then
5027 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
5028 ' );' );
5029 end;
5030
5031 function TKOLComboBox.SetupParams(const AName, AParent: String): String;
5032 var S: String;
5033 begin
5034 asm
5035 jmp @@e_signature
5036 DB '#$signature$#', 0
5037 DB 'TKOLComboBox.SetupParams', 0
5038 @@e_signature:
5039 end;
5040 if coReadOnly in Options then
5041 S := S + 'coReadOnly';
5042 if coNoHScroll in Options then
5043 S := S + ', coNoHScroll';
5044 if coAlwaysVScroll in Options then
5045 S := S + ', coAlwaysVScroll';
5046 if coLowerCase in Options then
5047 S := S + ', coLowerCase';
5048 if coNoIntegralHeight in Options then
5049 S := S + ', coNoIntegralHeight';
5050 if coOemConvert in Options then
5051 S := S + ', coOemConvert';
5052 if coSort in Options then
5053 S := S + ', coSort';
5054 if coUpperCase in Options then
5055 S := S + ', coUpperCase';
5056 if coOwnerDrawFixed in Options then
5057 S := S + ', coOwnerDrawFixed';
5058 if coOwnerDrawVariable in Options then
5059 S := S + ', coOwnerDrawVariable';
5060 if coSimple in Options then
5061 S := S + ', coSimple';
5062 if S <> '' then
5063 if S[ 1 ] = ',' then
5064 S := Copy( S, 3, MaxInt );
5065 Result := AParent + ', [ ' + S + ' ]';
5066 end;
5067
5068 function TKOLComboBox.TabStopByDefault: Boolean;
5069 begin
5070 asm
5071 jmp @@e_signature
5072 DB '#$signature$#', 0
5073 DB 'TKOLComboBox.TabStopByDefault', 0
5074 @@e_signature:
5075 end;
5076 Result := TRUE;
5077 end;
5078
5079 function TKOLComboBox.WYSIWIGPaintImplemented: Boolean;
5080 begin
5081 Result := TRUE;
5082 end;
5083
5084 { TKOLSplitter }
5085
5086 procedure TKOLSplitter.AssignEvents(SL: TStringList; const AName: String);
5087 begin
5088 asm
5089 jmp @@e_signature
5090 DB '#$signature$#', 0
5091 DB 'TKOLSplitter.AssignEvents', 0
5092 @@e_signature:
5093 end;
5094 inherited;
5095 DoAssignEvents( SL, AName, [ 'OnSplit' ], [ @OnSplit ] );
5096 end;
5097
5098 function TKOLSplitter.BestEventName: String;
5099 begin
5100 Result := 'OnSplit';
5101 end;
5102
5103 constructor TKOLSplitter.Create(AOwner: TComponent);
5104 begin
5105 asm
5106 jmp @@e_signature
5107 DB '#$signature$#', 0
5108 DB 'TKOLSplitter.Create', 0
5109 @@e_signature:
5110 end;
5111 inherited;
5112 Align := caLeft;
5113 Width := 4; DefaultWidth := Width;
5114 DefaultHeight := 4;
5115 MinSizePrev := 0;
5116 MinSizeNext := 0;
5117 //FBeveled := TRUE;
5118 EdgeStyle := esLowered;
5119 end;
5120
5121 procedure TKOLSplitter.CreateKOLControl(Recreating: boolean);
5122 var
5123 es: TEdgeStyle;
5124 begin
5125 if Recreating then
5126 es:=FEdgeStyle
5127 else
5128 es:=esLowered;
5129 FKOLCtrl:=NewSplitterEx(KOLParentCtrl, 0, 0, es);
5130 end;
5131
5132 function TKOLSplitter.IsCursorDefault: Boolean;
5133 begin
5134 asm
5135 jmp @@e_signature
5136 DB '#$signature$#', 0
5137 DB 'TKOLSplitter.IsCursorDefault', 0
5138 @@e_signature:
5139 end;
5140 case Align of
5141 caLeft, caRight: Result := (Trim(Cursor_)='') or (Trim(Cursor_)='IDC_SIZEWE');
5142 caTop, caBottom: Result := (Trim(Cursor_)='') or (Trim(Cursor_)='IDC_SIZENS');
5143 else Result := inherited IsCursorDefault;
5144 end;
5145 end;
5146
5147 function TKOLSplitter.NoDrawFrame: Boolean;
5148 begin
5149 Result:=FEdgeStyle <> esNone;
5150 end;
5151
5152 procedure TKOLSplitter.SetEdgeStyle(const Value: TEdgeStyle);
5153 begin
5154 asm
5155 jmp @@e_signature
5156 DB '#$signature$#', 0
5157 DB 'TKOLSplitter.SetEdgeStyle', 0
5158 @@e_signature:
5159 end;
5160 FEdgeStyle := Value;
5161 if Assigned(FKOLCtrl) then
5162 RecreateWnd;
5163 Change;
5164 end;
5165
5166 procedure TKOLSplitter.SetMinSizeNext(const Value: Integer);
5167 begin
5168 asm
5169 jmp @@e_signature
5170 DB '#$signature$#', 0
5171 DB 'TKOLSplitter.SetMinSizeNext', 0
5172 @@e_signature:
5173 end;
5174 FMinSizeNext := Value;
5175 Change;
5176 end;
5177
5178 procedure TKOLSplitter.SetMinSizePrev(const Value: Integer);
5179 begin
5180 asm
5181 jmp @@e_signature
5182 DB '#$signature$#', 0
5183 DB 'TKOLSplitter.SetMinSizePrev', 0
5184 @@e_signature:
5185 end;
5186 FMinSizePrev := Value;
5187 Change;
5188 end;
5189
5190 procedure TKOLSplitter.SetupFirst(SL: TStringList; const AName, AParent,
5191 Prefix: String);
5192 begin
5193 asm
5194 jmp @@e_signature
5195 DB '#$signature$#', 0
5196 DB 'TKOLSplitter.SetupFirst', 0
5197 @@e_signature:
5198 end;
5199 inherited;
5200 end;
5201
5202 function TKOLSplitter.SetupParams(const AName, AParent: String): String;
5203 const Styles: array[ TEdgeStyle ] of String = ( 'esRaised', 'esLowered', 'esNone' );
5204 begin
5205 asm
5206 jmp @@e_signature
5207 DB '#$signature$#', 0
5208 DB 'TKOLSplitter.SetupParams', 0
5209 @@e_signature:
5210 end;
5211 Result := AParent + ', ' + Int2Str( MinSizePrev ) + ', ' + Int2Str( MinSizeNext );
5212 if EdgeStyle <> esLowered then
5213 Result := Result + ', ' + Styles[ EdgeStyle ];
5214 end;
5215
5216 function TKOLSplitter.TypeName: String;
5217 begin
5218 asm
5219 jmp @@e_signature
5220 DB '#$signature$#', 0
5221 DB 'TKOLSplitter.TypeName', 0
5222 @@e_signature:
5223 end;
5224 Result := inherited TypeName;
5225 if EdgeStyle <> esLowered then
5226 Result := 'SplitterEx';
5227 end;
5228
5229 { TKOLPaintBox }
5230
5231 function TKOLPaintBox.BestEventName: String;
5232 begin
5233 Result := 'OnPaint';
5234 end;
5235
5236 constructor TKOLPaintBox.Create(AOwner: TComponent);
5237 begin
5238 asm
5239 jmp @@e_signature
5240 DB '#$signature$#', 0
5241 DB 'TKOLPaintBox.Create', 0
5242 @@e_signature:
5243 end;
5244 inherited;
5245 Width := 40; DefaultWidth := Width;
5246 Height := 40; DefaultHeight := Height;
5247 ControlStyle := ControlStyle + [ csAcceptsControls ];
5248 end;
5249
5250 procedure TKOLPaintBox.SetpopupMenu(const Value: TKOLPopupMenu);
5251 begin
5252 asm
5253 jmp @@e_signature
5254 DB '#$signature$#', 0
5255 DB 'TKOLPaintBox.SetpopupMenu', 0
5256 @@e_signature:
5257 end;
5258 FpopupMenu := Value;
5259 Change;
5260 end;
5261
5262 procedure TKOLPaintBox.SetupFirst(SL: TStringList; const AName, AParent,
5263 Prefix: String);
5264 begin
5265 asm
5266 jmp @@e_signature
5267 DB '#$signature$#', 0
5268 DB 'TKOLPaintBox.SetupFirst', 0
5269 @@e_signature:
5270 end;
5271 inherited;
5272 if Assigned( FpopupMenu ) then
5273 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
5274 ' );' );
5275 end;
5276
5277 function TKOLPaintBox.SetupParams(const AName, AParent: String): String;
5278 begin
5279 asm
5280 jmp @@e_signature
5281 DB '#$signature$#', 0
5282 DB 'TKOLPaintBox.SetupParams', 0
5283 @@e_signature:
5284 end;
5285 Result := AParent;
5286 end;
5287
5288 { TKOLListView }
5289
5290 procedure TKOLListView.AssignEvents(SL: TStringList; const AName: String);
5291 begin
5292 inherited;
5293 DoAssignEvents( SL, AName, [ 'OnLVDelete', 'OnLVCustomDraw'
5294 {$IFNDEF _D2}, 'OnLVDataW' {$ENDIF _D2} ],
5295 [ @ OnLVDelete, @ OnLVCustomDraw
5296 {$IFNDEF _D2}, @ OnLVDataW {$ENDIF _D2} ] );
5297 end;
5298
5299 constructor TKOLListView.Create(AOwner: TComponent);
5300 begin
5301 asm
5302 jmp @@e_signature
5303 DB '#$signature$#', 0
5304 DB 'TKOLListView.Create', 0
5305 @@e_signature:
5306 end;
5307 inherited;
5308 FCols := TList.Create;
5309 FGenerateColIdxConst := TRUE;
5310 Width := 200; DefaultWidth := Width;
5311 Height := 150; DefaultHeight := Height;
5312 FCurIndex := 0;
5313 FLVBkColor := clWindow;
5314 FLVTextBkColor := clWindow;
5315 TabStop := TRUE;
5316 end;
5317
5318 function TKOLListView.DefaultColor: TColor;
5319 begin
5320 asm
5321 jmp @@e_signature
5322 DB '#$signature$#', 0
5323 DB 'TKOLListView.DefaultColor', 0
5324 @@e_signature:
5325 end;
5326 Result := clWindow;
5327 end;
5328
5329 procedure TKOLListView.DefineProperties(Filer: TFiler);
5330 var I: Integer;
5331 Col: TKOLListViewColumn;
5332 begin
5333 inherited;
5334 Filer.DefineProperty( 'ColCount', LoadColCount, SaveColCount, TRUE );
5335 for I := 0 to FColCount-1 do
5336 begin
5337 if FCols.Count <= I then
5338 Col := TKOLListViewColumn.Create( Self )
5339 else
5340 Col := FCols[ I ];
5341 Col.DefProps( 'Column' + IntToStr( I ), Filer );
5342 end;
5343 end;
5344
5345 destructor TKOLListView.Destroy;
5346 var I: Integer;
5347 begin
5348 ActiveDesign.Free;
5349 if ImageListNormal <> nil then
5350 ImageListNormal.NotifyLinkedComponent( Self, noRemoved );
5351 if ImageListSmall <> nil then
5352 ImageListSmall.NotifyLinkedComponent( Self, noRemoved );
5353 if ImageListState <> nil then
5354 ImageListState.NotifyLinkedComponent( Self, noRemoved );
5355 for I := FCols.Count-1 downto 0 do
5356 TObject( FCols[ I ] ).Free;
5357 FCols.Free;
5358 inherited;
5359 end;
5360
5361 procedure TKOLListView.DoGenerateConstants(SL: TStringList);
5362 var I: Integer;
5363 Col: TKOLListViewColumn;
5364 begin
5365 if not generateConstants then Exit;
5366 for I := 0 to Cols.Count-1 do
5367 begin
5368 Col := Cols[ I ];
5369 if Col.Name <> '' then
5370 SL.Add( 'const ' + Col.Name + ' = ' + IntToStr( I ) + ';' );
5371 end;
5372 end;
5373
5374 function TKOLListView.GetCaption: String;
5375 begin
5376 asm
5377 jmp @@e_signature
5378 DB '#$signature$#', 0
5379 DB 'TKOLListView.GetCaption', 0
5380 @@e_signature:
5381 end;
5382 Result := inherited Caption;
5383 end;
5384
5385 function TKOLListView.GetColor: TColor;
5386 begin
5387 asm
5388 jmp @@e_signature
5389 DB '#$signature$#', 0
5390 DB 'TKOLListView.GetColor', 0
5391 @@e_signature:
5392 end;
5393 Result := inherited Color;
5394 end;
5395
5396 function TKOLListView.GetColumns: String;
5397 //var I: Integer;
5398 begin
5399 Result := '';
5400 if Cols.Count > 0 then
5401 Result := IntToStr( Cols.Count ) + ' columns';
5402 {for I := 0 to Cols.Count-1 do
5403 begin
5404 if Result <> '' then Result := Result + ';';
5405 Result := Result + Trim( TKOLListViewColumn( Cols[ I ] ).Caption );
5406 end;}
5407 end;
5408
5409 function TKOLListView.HasOrderedColumns: Boolean;
5410 var I: Integer;
5411 C: TKOLListViewColumn;
5412 begin
5413 Result := FALSE;
5414 for I := 0 to Cols.Count-1 do
5415 begin
5416 C := Cols[ I ];
5417 if C.FLVColOrder >= 0 then
5418 begin
5419 Result := TRUE;
5420 break;
5421 end;
5422 end;
5423 end;
5424
5425 {YS}
5426 procedure TKOLListView.Invalidate;
5427 begin
5428 {$IFDEF _KOLCtrlWrapper_}
5429 if Assigned(FKOLCtrl) then
5430 FKOLCtrl.InvalidateEx
5431 else
5432 {$ENDIF}
5433 inherited;
5434 end;
5435
5436 procedure TKOLListView.Loaded;
5437 begin
5438 inherited;
5439 UpdateColumns;
5440 end;
5441 {YS}
5442 procedure TKOLListView.LoadColCount(Reader: TReader);
5443 begin
5444 FColCount := Reader.ReadInteger;
5445 end;
5446
5447 procedure TKOLListView.NotifyLinkedComponent(Sender: TObject;
5448 Operation: TNotifyOperation);
5449 begin
5450 asm
5451 jmp @@e_signature
5452 DB '#$signature$#', 0
5453 DB 'TKOLListView.NotifyLinkedComponent', 0
5454 @@e_signature:
5455 end;
5456 inherited;
5457 if Operation = noRemoved then
5458 begin
5459 if Sender = FImageListNormal then
5460 ImageListNormal := nil;
5461 if Sender = FImageListSmall then
5462 ImageListSmall := nil;
5463 if Sender = FImageListState then
5464 ImageListState := nil;
5465 end;
5466 end;
5467
5468 procedure TKOLListView.SaveColCount(Writer: TWriter);
5469 begin
5470 FColCount := FCols.Count;
5471 Writer.WriteInteger( FColCount );
5472 end;
5473
5474 procedure TKOLListView.SetColor(const Value: TColor);
5475 begin
5476 asm
5477 jmp @@e_signature
5478 DB '#$signature$#', 0
5479 DB 'TKOLListView.SetColor', 0
5480 @@e_signature:
5481 end;
5482 inherited Color := Value;
5483 end;
5484
5485 procedure TKOLListView.SetColumns(const Value: String);
5486 begin
5487 //
5488 end;
5489
5490 procedure TKOLListView.SetGenerateColIdxConst(const Value: Boolean);
5491 begin
5492 FGenerateColIdxConst := Value;
5493 Change;
5494 end;
5495
5496 procedure TKOLListView.SetImageListNormal(const Value: TKOLImageList);
5497 begin
5498 asm
5499 jmp @@e_signature
5500 DB '#$signature$#', 0
5501 DB 'TKOLListView.SetImageListNormal', 0
5502 @@e_signature:
5503 end;
5504 if FImageListNormal <> nil then
5505 FImageListNormal.NotifyLinkedComponent( Self, noRemoved );
5506 FImageListNormal := Value;
5507 if Value <> nil then
5508 Value.AddToNotifyList( Self );
5509 Change;
5510 end;
5511
5512 procedure TKOLListView.SetImageListSmall(const Value: TKOLImageList);
5513 begin
5514 asm
5515 jmp @@e_signature
5516 DB '#$signature$#', 0
5517 DB 'TKOLListView.SetImageListSmall', 0
5518 @@e_signature:
5519 end;
5520 if FImageListSmall <> nil then
5521 FImageListSmall.NotifyLinkedComponent( Self, noRemoved );
5522 FImageListSmall := Value;
5523 if Value <> nil then
5524 Value.AddToNotifyList( Self );
5525 Change;
5526 end;
5527
5528 procedure TKOLListView.SetImageListState(const Value: TKOLImageList);
5529 begin
5530 asm
5531 jmp @@e_signature
5532 DB '#$signature$#', 0
5533 DB 'TKOLListView.SetImageListState', 0
5534 @@e_signature:
5535 end;
5536 if FImageListState <> nil then
5537 FImageListState.NotifyLinkedComponent( Self, noRemoved );
5538 FImageListState := Value;
5539 if Value <> nil then
5540 Value.AddToNotifyList( Self );
5541 Change;
5542 end;
5543
5544 procedure TKOLListView.SetLVCount(Value: Integer);
5545 begin
5546 asm
5547 jmp @@e_signature
5548 DB '#$signature$#', 0
5549 DB 'TKOLListView.SetLVCount', 0
5550 @@e_signature:
5551 end;
5552 if Value < 0 then
5553 Value := 0;
5554 FLVCount := Value;
5555 Change;
5556 end;
5557
5558 procedure TKOLListView.SetLVTextBkColor(const Value: TColor);
5559 begin
5560 asm
5561 jmp @@e_signature
5562 DB '#$signature$#', 0
5563 DB 'TKOLListView.SetLVTextBkColor', 0
5564 @@e_signature:
5565 end;
5566 FLVTextBkColor := Value;
5567 Change;
5568 end;
5569
5570 procedure TKOLListView.SetOnLVCustomDraw(const Value: TOnLVCustomDraw);
5571 begin
5572 FOnLVCustomDraw := Value;
5573 Change;
5574 end;
5575
5576 procedure TKOLListView.SetOnLVDelete(const Value: TOnLVDelete);
5577 begin
5578 FOnLVDelete := Value;
5579 Change;
5580 end;
5581
5582 procedure TKOLListView.SetOptions(const Value: TKOLListViewOptions);
5583 var
5584 Opts: kol.TListViewOptions;
5585 OldOpts: TKOLListViewOptions;
5586 begin
5587 asm
5588 jmp @@e_signature
5589 DB '#$signature$#', 0
5590 DB 'TKOLListView.SetOptions', 0
5591 @@e_signature:
5592 end;
5593 OldOpts := FOptions;
5594 FOptions := Value;
5595 if Assigned(FKOLCtrl) then begin
5596 if ([lvoNoScroll, lvoNoSortHeader] * OldOpts <> []) or ([lvoNoScroll, lvoNoSortHeader] * Value <> []) then
5597 RecreateWnd
5598 else begin
5599 Opts:=[];
5600 if lvoGridLines in FOptions then
5601 Include(Opts, kol.lvoGridLines);
5602 if lvoFlatsb in FOptions then
5603 Include(Opts, kol.lvoFlatsb);
5604 FKOLCtrl.LVOptions:=Opts;
5605 UpdateAllowSelfPaint;
5606 end;
5607 end;
5608 Change;
5609 end;
5610
5611 procedure TKOLListView.SetpopupMenu(const Value: TKOLPopupMenu);
5612 begin
5613 asm
5614 jmp @@e_signature
5615 DB '#$signature$#', 0
5616 DB 'TKOLListView.SetpopupMenu', 0
5617 @@e_signature:
5618 end;
5619 FpopupMenu := Value;
5620 Change;
5621 end;
5622
5623 procedure TKOLListView.SetStyle(const Value: TKOLListViewStyle);
5624 begin
5625 asm
5626 jmp @@e_signature
5627 DB '#$signature$#', 0
5628 DB 'TKOLListView.SetStyle', 0
5629 @@e_signature:
5630 end;
5631 FStyle := Value;
5632 {YS}
5633 {$IFDEF _KOLCtrlWrapper_}
5634 if Assigned( FKOLCtrl ) then
5635 FKOLCtrl.LVStyle:=TListViewStyle(Value);
5636 UpdateAllowSelfPaint;
5637 {$ENDIF}
5638 {YS}
5639 Change;
5640 end;
5641
5642 procedure TKOLListView.SetupFirst(SL: TStringList; const AName, AParent,
5643 Prefix: String);
5644 var I: Integer;
5645 Col: TKOLListViewColumn;
5646 W: Integer;
5647 WifUnicode: String;
5648 begin
5649 asm
5650 jmp @@e_signature
5651 DB '#$signature$#', 0
5652 DB 'TKOLListView.SetupFirst', 0
5653 @@e_signature:
5654 end;
5655 inherited;
5656 if Unicode then WifUnicode := 'W' else WifUnicode := '';
5657 if (Font.Color <> clWindowText) and (Font.Color <> clNone) and (Font.Color <> clDefault) then
5658 SL.Add( Prefix + AName + '.LVTextColor := ' + Color2Str( Font.Color ) + ';' );
5659 if (LVTextBkColor <> clDefault) and (LVTextBkColor <> clNone) and (LVTextBkColor <> clWindow) then
5660 SL.Add( Prefix + AName + '.LVTextBkColor := ' + Color2Str( LVTextBkColor ) + ';' );
5661 if (LVBkColor <> clDefault) and (LVBkColor <> clNone) and (LVBkColor <> clWindow) then
5662 SL.Add( Prefix + AName + '.LVBkColor := ' + Color2Str( LVBkColor ) + ';' );
5663 if Assigned( FpopupMenu ) then
5664 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
5665 ' );' );
5666 for I := 0 to Cols.Count-1 do
5667 begin
5668 Col := Cols[ I ];
5669 W := Col.Width;
5670 if Col.FLVColRightImg then
5671 W := -W;
5672 SL.Add( Prefix + AName + '.LVColAdd' + WifUnicode + '( ' +
5673 StringConstant( 'Column' + IntToStr( I ) + 'Caption',
5674 Col.Caption ) + ', ' +
5675 TextAligns[ Col.TextAlign ] + ', ' + IntToStr( W ) + ');' );
5676 if Col.LVColImage >= 0 then
5677 SL.Add( Prefix + AName + '.LVColImage[ ' + IntToStr( I ) + ' ] := ' +
5678 IntToStr( Col.LVColImage ) + ';' );
5679 end;
5680 for I := 0 to Cols.Count-1 do
5681 begin
5682 Col := Cols[ I ];
5683 if Col.LVColOrder >= 0 then
5684 if Col.LVColOrder <> I then
5685 SL.Add( Prefix + AName + '.LVColOrder[ ' + IntToStr( I ) + ' ] := ' +
5686 IntToStr( Col.LVColOrder ) + ';' );
5687 end;
5688 end;
5689
5690 procedure TKOLListView.SetupLast(SL: TStringList; const AName, AParent,
5691 Prefix: String);
5692 begin
5693 asm
5694 jmp @@e_signature
5695 DB '#$signature$#', 0
5696 DB 'TKOLListView.SetupLast', 0
5697 @@e_signature:
5698 end;
5699 inherited;
5700 if LVCount > 0 then
5701 SL.Add( Prefix + AName + '.LVCount := ' + IntToStr( LVCount ) + ';' );
5702 end;
5703
5704 function TKOLListView.SetupParams(const AName, AParent: String): String;
5705 var S, O, ILSm, ILNr, ILSt: String;
5706 begin
5707 asm
5708 jmp @@e_signature
5709 DB '#$signature$#', 0
5710 DB 'TKOLListView.SetupParams', 0
5711 @@e_signature:
5712 end;
5713 case Style of
5714 lvsIcon: S := 'lvsIcon';
5715 lvsSmallIcon: S := 'lvsSmallIcon';
5716 lvsList: S := 'lvsList';
5717 lvsDetail: S := 'lvsDetail';
5718 lvsDetailNoHeader: S := 'lvsDetailNoHeader';
5719 end;
5720 O := '';
5721 if lvoIconLeft in Options then
5722 O := 'lvoIconLeft';
5723 if lvoAutoArrange in Options then
5724 O := O + ', lvoAutoArrange';
5725 if lvoButton in Options then
5726 O := O + ', lvoButton';
5727 if lvoEditLabel in Options then
5728 O := O + ', lvoEditLabel';
5729 if lvoNoLabelWrap in Options then
5730 O := O + ', lvoNoLabelWrap';
5731 if lvoNoScroll in Options then
5732 O := O + ', lvoNoScroll';
5733 if lvoNoSortHeader in Options then
5734 O := O + ', lvoNoSortHeader';
5735 if lvoHideSel in Options then
5736 O := O + ', lvoHideSel';
5737 if lvoMultiselect in Options then
5738 O := O + ', lvoMultiselect';
5739 if lvoSortAscending in Options then
5740 O := O + ', lvoSortAscending';
5741 if lvoSortDescending in Options then
5742 O := O + ', lvoSortDescending';
5743 if lvoGridLines in Options then
5744 O := O + ', lvoGridLines';
5745 if lvoSubItemImages in Options then
5746 O := O + ', lvoSubItemImages';
5747 if lvoCheckBoxes in Options then
5748 O := O + ', lvoCheckBoxes';
5749 if lvoTrackSelect in Options then
5750 O := O + ', lvoTrackSelect';
5751 if lvoHeaderDragDrop in Options then
5752 O := O + ', lvoHeaderDragDrop';
5753 if lvoRowSelect in Options then
5754 O := O + ', lvoRowSelect';
5755 if lvoOneClickActivate in Options then
5756 O := O + ', lvoOneClickActivate';
5757 if lvoTwoClickActivate in Options then
5758 O := O + ', lvoTwoClickActivate';
5759 if lvoFlatsb in Options then
5760 O := O + ', lvoFlatsb';
5761 if lvoRegional in Options then
5762 O := O + ', lvoRegional';
5763 if lvoInfoTip in Options then
5764 O := O + ', lvoInfoTip';
5765 if lvoUnderlineHot in Options then
5766 O := O + ', lvoUnderlineHot';
5767 if lvoMultiWorkares in Options then
5768 O := O + ', lvoMultiWorkares';
5769 if lvoOwnerData in Options then
5770 O := O + ', lvoOwnerData';
5771 if lvoOwnerDrawFixed in Options then
5772 O := O + ', lvoOwnerDrawFixed';
5773 if O <> '' then
5774 if O[ 1 ] = ',' then
5775 O := Copy( O, 3, MaxInt );
5776 ILSm := 'nil';
5777 if ImageListSmall <> nil then
5778 begin
5779 if ImageListSmall.ParentFORM.Name = ParentForm.Name then
5780 ILSm := 'Result.' + ImageListSmall.Name
5781 else
5782 ILSm := ImageListSmall.ParentFORM.Name +'.'+ ImageListSmall.Name;
5783 end;
5784 ILNr := 'nil';
5785 if ImageListNormal <> nil then
5786 begin
5787 if ImageListNormal.ParentFORM.Name = ParentForm.Name then
5788 ILNr := 'Result.' + ImageListNormal.Name
5789 else
5790 ILNr := ImageListNormal.ParentFORM.Name +'.'+ ImageListNormal.Name;
5791 end;
5792 ILSt := 'nil';
5793 if ImageListState <> nil then
5794 begin
5795 if ImageListState.ParentFORM.Name = ParentForm.Name then
5796 ILSt := 'Result.' + ImageListState.Name
5797 else
5798 ILSt := ImageListState.ParentFORM.Name +'.'+ ImageListState.Name;
5799 end;
5800 Result := AParent + ', ' + S + ', [ ' + O + ' ], ' + ILSm + ', ' + ILNr
5801 + ', ' + ILSt;
5802 end;
5803
5804 function TKOLListView.TabStopByDefault: Boolean;
5805 begin
5806 asm
5807 jmp @@e_signature
5808 DB '#$signature$#', 0
5809 DB 'TKOLListView.TabStopByDefault', 0
5810 @@e_signature:
5811 end;
5812 Result := TRUE;
5813 end;
5814 {YS}
5815 procedure TKOLListView.UpdateColumns;
5816 {$IFDEF _KOLCtrlWrapper_}
5817 var
5818 i: integer;
5819 col: TKOLListViewColumn;
5820 {$ENDIF}
5821 begin
5822 {$IFDEF _KOLCtrlWrapper_}
5823 if Assigned(FKOLCtrl) then
5824 with FKOLCtrl^ do begin
5825 BeginUpdate;
5826 try
5827 while LVColCount > 0 do
5828 LVColDelete(0);
5829 for i:=0 to FCols.Count - 1 do begin
5830 col:=FCols[i];
5831 LVColAdd(col.Caption, KOL.TTextAlign(col.TextAlign), col.Width)
5832 end;
5833 finally
5834 EndUpdate;
5835 end;
5836 UpdateAllowSelfPaint;
5837 end;
5838 {$ENDIF}
5839 end;
5840
5841 procedure TKOLListView.CreateKOLControl(Recreating: boolean);
5842 var
5843 Opts: kol.TListViewOptions;
5844 begin
5845 Opts:=[];
5846 if lvoGridLines in FOptions then
5847 Include(Opts, kol.lvoGridLines);
5848 if lvoFlatsb in FOptions then
5849 Include(Opts, kol.lvoFlatsb);
5850 if lvoNoScroll in FOptions then
5851 Include(Opts, kol.lvoNoScroll);
5852 if lvoNoSortHeader in FOptions then
5853 Include(Opts, kol.lvoNoSortHeader);
5854 FKOLCtrl := NewListView(KOLParentCtrl, TListViewStyle(Style), opts, nil, nil, nil);
5855 end;
5856
5857 function TKOLListView.NoDrawFrame: Boolean;
5858 begin
5859 Result:=HasBorder;
5860 end;
5861 {YS}
5862
5863 procedure TKOLListView.KOLControlRecreated;
5864 begin
5865 inherited;
5866 UpdateColumns;
5867 end;
5868
5869 function TKOLListView.GetDefaultControlFont: HFONT;
5870 begin
5871 Result:=GetStockObject(DEFAULT_GUI_FONT);
5872 end;
5873
5874 {$IFNDEF _D2}
5875 procedure TKOLListView.SetOnLVDataW(const Value: TOnLVDataW);
5876 begin
5877 FOnLVDataW := Value;
5878 Change;
5879 end;
5880 {$ENDIF _D2}
5881
5882 procedure TKOLListView.SetLVItemHeight(const Value: Integer);
5883 begin
5884 if fLVItemHeight <> Value then begin
5885 fLVItemHeight := Value;
5886 Change;
5887 end;
5888 end;
5889
5890 function TKOLListView.GenerateTransparentInits: String;
5891 begin
5892 if fLVItemHeight > 0 then Result := '.SetLVItemHeight('+IntToStr(fLVItemHeight)+')'
5893 else Result := '';
5894 Result := Result + inherited GenerateTransparentInits();
5895 end;
5896
5897 { TKOLTreeView }
5898
5899 constructor TKOLTreeView.Create(AOwner: TComponent);
5900 begin
5901 asm
5902 jmp @@e_signature
5903 DB '#$signature$#', 0
5904 DB 'TKOLTreeView.Create', 0
5905 @@e_signature:
5906 end;
5907 inherited;
5908 Width := 150; DefaultWidth := Width;
5909 Height := 200; DefaultHeight := Height;
5910 FCurIndex := 0;
5911 TabStop := TRUE;
5912 end;
5913
5914 procedure TKOLTreeView.CreateKOLControl(Recreating: boolean);
5915 begin
5916 FKOLCtrl:=NewTreeView(KOLParentCtrl, [], nil, nil);
5917 end;
5918
5919 function TKOLTreeView.DefaultColor: TColor;
5920 begin
5921 asm
5922 jmp @@e_signature
5923 DB '#$signature$#', 0
5924 DB 'TKOLTreeView.DefaultColor', 0
5925 @@e_signature:
5926 end;
5927 Result := clWindow;
5928 end;
5929
5930 destructor TKOLTreeView.Destroy;
5931 begin
5932 if ImageListNormal <> nil then
5933 ImageListNormal.NotifyLinkedComponent( Self, noRemoved );
5934 if ImageListState <> nil then
5935 ImageListState.NotifyLinkedComponent( Self, noRemoved );
5936 inherited;
5937 end;
5938
5939 function TKOLTreeView.NoDrawFrame: Boolean;
5940 begin
5941 Result:=HasBorder;
5942 end;
5943
5944 procedure TKOLTreeView.NotifyLinkedComponent(Sender: TObject;
5945 Operation: TNotifyOperation);
5946 begin
5947 asm
5948 jmp @@e_signature
5949 DB '#$signature$#', 0
5950 DB 'TKOLTreeView.NotifyLinkedComponent', 0
5951 @@e_signature:
5952 end;
5953 inherited;
5954 if Operation = noRemoved then
5955 begin
5956 if Sender = FImageListNormal then
5957 ImageListNormal := nil;
5958 if Sender = FImageListState then
5959 ImageListState := nil;
5960 end;
5961 end;
5962
5963 procedure TKOLTreeView.SetCurIndex(const Value: Integer);
5964 begin
5965 asm
5966 jmp @@e_signature
5967 DB '#$signature$#', 0
5968 DB 'TKOLTreeView.SetCurIndex', 0
5969 @@e_signature:
5970 end;
5971 FCurIndex := Value;
5972 Change;
5973 end;
5974
5975 procedure TKOLTreeView.SetImageListNormal(const Value: TKOLImageList);
5976 begin
5977 asm
5978 jmp @@e_signature
5979 DB '#$signature$#', 0
5980 DB 'TKOLTreeView.SetImageListNormal', 0
5981 @@e_signature:
5982 end;
5983 if FImageListNormal <> nil then
5984 FImageListNormal.NotifyLinkedComponent( Self, noRemoved );
5985 FImageListNormal := Value;
5986 if Value <> nil then
5987 Value.AddToNotifyList( Self );
5988 Change;
5989 end;
5990
5991 procedure TKOLTreeView.SetImageListState(const Value: TKOLImageList);
5992 begin
5993 asm
5994 jmp @@e_signature
5995 DB '#$signature$#', 0
5996 DB 'TKOLTreeView.SetImageListState', 0
5997 @@e_signature:
5998 end;
5999 if FImageListState <> nil then
6000 FImageListState.NotifyLinkedComponent( Self, noRemoved );
6001 FImageListState := Value;
6002 if Value <> nil then
6003 Value.AddToNotifyList( Self );
6004 Change;
6005 end;
6006
6007 procedure TKOLTreeView.SetOptions(const Value: TKOLTreeViewOptions);
6008 begin
6009 asm
6010 jmp @@e_signature
6011 DB '#$signature$#', 0
6012 DB 'TKOLTreeView.SetOptions', 0
6013 @@e_signature:
6014 end;
6015 FOptions := Value;
6016 Change;
6017 end;
6018
6019 procedure TKOLTreeView.SetpopupMenu(const Value: TKOLPopupMenu);
6020 begin
6021 asm
6022 jmp @@e_signature
6023 DB '#$signature$#', 0
6024 DB 'TKOLTreeView.SetpopupMenu', 0
6025 @@e_signature:
6026 end;
6027 FpopupMenu := Value;
6028 Change;
6029 end;
6030
6031 procedure TKOLTreeView.SetTVIndent(const Value: Integer);
6032 begin
6033 asm
6034 jmp @@e_signature
6035 DB '#$signature$#', 0
6036 DB 'TKOLTreeView.SetTVIndent', 0
6037 @@e_signature:
6038 end;
6039 FTVIndent := Value;
6040 Change;
6041 end;
6042
6043 procedure TKOLTreeView.SetTVRightClickSelect(const Value: Boolean);
6044 begin
6045 asm
6046 jmp @@e_signature
6047 DB '#$signature$#', 0
6048 DB 'TKOLTreeView,SetTVRightClickSelect', 0
6049 @@e_signature:
6050 end;
6051 FTVRightClickSelect := Value;
6052 Change;
6053 end;
6054
6055 procedure TKOLTreeView.SetupFirst(SL: TStringList; const AName, AParent,
6056 Prefix: String);
6057 begin
6058 asm
6059 jmp @@e_signature
6060 DB '#$signature$#', 0
6061 DB 'TKOLTreeView.SetupFirst', 0
6062 @@e_signature:
6063 end;
6064 inherited;
6065 if TVRightClickSelect then
6066 SL.Add( Prefix + AName + '.TVRightClickSelect := TRUE;' );
6067 if TVIndent > 0 then
6068 SL.Add( Prefix + AName + '.TVIndent := ' + IntToStr( TVIndent ) + ';' );
6069 if Assigned( FpopupMenu ) then
6070 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
6071 ' );' );
6072 end;
6073
6074 function TKOLTreeView.SetupParams(const AName, AParent: String): String;
6075 var O, ILNr, ILSt: String;
6076 begin
6077 asm
6078 jmp @@e_signature
6079 DB '#$signature$#', 0
6080 DB 'TKOLTreeView.SetupParams', 0
6081 @@e_signature:
6082 end;
6083 O := '';
6084 if tvoNoLines in Options then
6085 O := 'tvoNoLines';
6086 if tvoLinesRoot in Options then
6087 O := O + ', tvoLinesRoot';
6088 if tvoNoButtons in Options then
6089 O := O + ', tvoNoButtons';
6090 if tvoEditLabels in Options then
6091 O := O + ', tvoEditLabels';
6092 if tvoHideSel in Options then
6093 O := O + ', tvoHideSel';
6094 if tvoDragDrop in Options then
6095 O := O + ', tvoDragDrop';
6096 if tvoNoTooltips in Options then
6097 O := O + ', tvoNoTooltips';
6098 if tvoCheckBoxes in Options then
6099 O := O + ', tvoCheckBoxes';
6100 if tvoTrackSelect in Options then
6101 O := O + ', tvoTrackSelect';
6102 if tvoSingleExpand in Options then
6103 O := O + ', tvoSingleExpand';
6104 if tvoInfoTip in Options then
6105 O := O + ', tvoInfoTip';
6106 if tvoFullRowSelect in Options then
6107 O := O + ', tvoFullRowSelect';
6108 if tvoNoScroll in Options then
6109 O := O + ', tvoNoScroll';
6110 if tvoNonEvenHeight in Options then
6111 O := O + ', tvoNonEvenHeight';
6112 if O <> '' then
6113 if O[ 1 ] = ',' then
6114 O := Copy( O, 3, MaxInt );
6115 ILNr := 'nil';
6116 if ImageListNormal <> nil then
6117 begin
6118 if ImageListNormal.ParentFORM.Name = ParentForm.Name then
6119 ILNr := 'Result.' + ImageListNormal.Name
6120 else
6121 ILNr := ImageListNormal.ParentFORM.Name +'.'+ ImageListNormal.Name;
6122 end;
6123 ILSt := 'nil';
6124 if ImageListState <> nil then
6125 begin
6126 if ImageListState.ParentFORM.Name = ParentForm.Name then
6127 ILSt := 'Result.' + ImageListState.Name
6128 else
6129 ILSt := ImageListState.ParentFORM.Name +'.'+ ImageListState.Name;
6130 end;
6131 Result := AParent + ', [ ' + O + ' ], ' + ILNr + ', ' + ILSt;
6132 end;
6133
6134 function TKOLTreeView.TabStopByDefault: Boolean;
6135 begin
6136 asm
6137 jmp @@e_signature
6138 DB '#$signature$#', 0
6139 DB 'TKOLTreeView.TabStopByDefault', 0
6140 @@e_signature:
6141 end;
6142 Result := TRUE;
6143 end;
6144
6145 { TKOLRichEdit }
6146
6147 function TKOLRichEdit.AdditionalUnits: String;
6148 begin
6149 Result := inherited AdditionalUnits;
6150 if OLESupport then
6151 Result := Result + ', KOLOLERE';
6152 end;
6153
6154 procedure TKOLRichEdit.AfterFontChange( SL: TStrings; const AName, Prefix: String );
6155 begin
6156 asm
6157 jmp @@e_signature
6158 DB '#$signature$#', 0
6159 DB 'TKOLRichEdit.AfterFontChange', 0
6160 @@e_signature:
6161 end;
6162 SL.Add( Prefix + AName + '.RE_CharFmtArea := raSelection;' );
6163 end;
6164
6165 procedure TKOLRichEdit.BeforeFontChange( SL: TStrings; const AName, Prefix: String );
6166 begin
6167 asm
6168 jmp @@e_signature
6169 DB '#$signature$#', 0
6170 DB 'TKOLRichEdit.BeforeFontChange', 0
6171 @@e_signature:
6172 end;
6173 SL.Add( Prefix + AName + '.RE_CharFmtArea := raAll;' );
6174 end;
6175
6176 function TKOLRichEdit.BestEventName: String;
6177 begin
6178 Result := 'OnChange';
6179 end;
6180
6181 constructor TKOLRichEdit.Create(AOwner: TComponent);
6182 begin
6183 asm
6184 jmp @@e_signature
6185 DB '#$signature$#', 0
6186 DB 'TKOLRichEdit.Create', 0
6187 @@e_signature:
6188 end;
6189 FLines := TStringList.Create;
6190 inherited;
6191 FDefIgnoreDefault := TRUE;
6192 FIgnoreDefault := TRUE;
6193 Width := 164; DefaultWidth := 100;
6194 Height := 200; DefaultHeight := Height;
6195 TabStop := TRUE;
6196 version := ver3;
6197 FMaxTextSize := 32767;
6198 end;
6199
6200 procedure TKOLRichEdit.CreateKOLControl(Recreating: boolean);
6201 var
6202 opts: kol.TEditOptions;
6203 begin
6204 opts:=[];
6205 if eo_Lowercase in FOptions then
6206 Include(opts, kol.eoLowercase);
6207 if eo_NoHScroll in FOptions then
6208 Include(opts, kol.eoNoHScroll);
6209 if eo_NoVScroll in FOptions then
6210 Include(opts, kol.eoNoVScroll);
6211 if eo_UpperCase in FOptions then
6212 Include(opts, kol.eoUpperCase);
6213 FKOLCtrl:=NewRichEdit(KOLParentCtrl, opts);
6214 end;
6215
6216 function TKOLRichEdit.DefaultColor: TColor;
6217 begin
6218 asm
6219 jmp @@e_signature
6220 DB '#$signature$#', 0
6221 DB 'TKOLRichEdit.DefaultColor', 0
6222 @@e_signature:
6223 end;
6224 Result := clWindow;
6225 end;
6226
6227 destructor TKOLRichEdit.Destroy;
6228 begin
6229 asm
6230 jmp @@e_signature
6231 DB '#$signature$#', 0
6232 DB 'TKOLRichEdit.Destroy', 0
6233 @@e_signature:
6234 end;
6235 FLines.Free;
6236 inherited;
6237 end;
6238
6239 procedure TKOLRichEdit.FirstCreate;
6240 begin
6241 asm
6242 jmp @@e_signature
6243 DB '#$signature$#', 0
6244 DB 'TKOLRichEdit.FirstCreate', 0
6245 @@e_signature:
6246 end;
6247 FLines.Text := Name;
6248 inherited;
6249 end;
6250
6251 function TKOLRichEdit.FontPropName: String;
6252 begin
6253 asm
6254 jmp @@e_signature
6255 DB '#$signature$#', 0
6256 DB 'TKOLRichEdit.FontPropName', 0
6257 @@e_signature:
6258 end;
6259 Result := 'RE_Font';
6260 end;
6261
6262 function TKOLRichEdit.GenerateTransparentInits: String;
6263 begin
6264 asm
6265 jmp @@e_signature
6266 DB '#$signature$#', 0
6267 DB 'TKOLRichEdit.GenerateTransparentInits', 0
6268 @@e_signature:
6269 end;
6270 Result := inherited GenerateTransparentInits;
6271 if RE_FmtStandard then
6272 Result := Result + '.RE_FmtStandard';
6273 end;
6274
6275 function TKOLRichEdit.GetCaption: String;
6276 begin
6277 asm
6278 jmp @@e_signature
6279 DB '#$signature$#', 0
6280 DB 'TKOLRichEdit.GetCaption', 0
6281 @@e_signature:
6282 end;
6283 Result := FLines.Text;
6284 end;
6285
6286 function TKOLRichEdit.GetText: TStrings;
6287 begin
6288 asm
6289 jmp @@e_signature
6290 DB '#$signature$#', 0
6291 DB 'TKOLRichEdit.GetText', 0
6292 @@e_signature:
6293 end;
6294 Result := FLines;
6295 end;
6296
6297 procedure TKOLRichEdit.KOLControlRecreated;
6298 begin
6299 inherited;
6300 if Assigned(FKOLCtrl) then
6301 FKOLCtrl.Text:=FLines.Text;
6302 end;
6303
6304 procedure TKOLRichEdit.Loaded;
6305 begin
6306 inherited;
6307 if Assigned(FKOLCtrl) then
6308 FKOLCtrl.Text:=FLines.Text;
6309 end;
6310
6311 function TKOLRichEdit.NoDrawFrame: Boolean;
6312 begin
6313 Result:=HasBorder;
6314 end;
6315
6316 procedure TKOLRichEdit.SetMaxTextSize(const Value: DWORD);
6317 begin
6318 asm
6319 jmp @@e_signature
6320 DB '#$signature$#', 0
6321 DB 'TKOLRichEdit.SetMaxTextSize', 0
6322 @@e_signature:
6323 end;
6324 FMaxTextSize := Value;
6325 Change;
6326 end;
6327
6328 procedure TKOLRichEdit.SetOLESupport(const Value: Boolean);
6329 begin
6330 FOLESupport := Value;
6331 Change;
6332 end;
6333
6334 procedure TKOLRichEdit.SetOptions(const Value: TKOLMemoOptions);
6335 begin
6336 asm
6337 jmp @@e_signature
6338 DB '#$signature$#', 0
6339 DB 'TKOLRichEdit.SetOptions', 0
6340 @@e_signature:
6341 end;
6342 if FOptions = Value then exit;
6343 FOptions := Value;
6344 if Assigned(FKOLCtrl) then
6345 RecreateWnd;
6346 Change;
6347 end;
6348
6349 procedure TKOLRichEdit.SetpopupMenu(const Value: TKOLPopupMenu);
6350 begin
6351 asm
6352 jmp @@e_signature
6353 DB '#$signature$#', 0
6354 DB 'TKOLRichEdit.SetpopupMenu', 0
6355 @@e_signature:
6356 end;
6357 FpopupMenu := Value;
6358 Change;
6359 end;
6360
6361 procedure TKOLRichEdit.SetRE_AutoKeybdSet(const Value: Boolean);
6362 begin
6363 asm
6364 jmp @@e_signature
6365 DB '#$signature$#', 0
6366 DB 'TKOLRichEdit.SetRE_AutoKeybdSet', 0
6367 @@e_signature:
6368 end;
6369 FRE_AutoKeybdSet := Value;
6370 Change;
6371 end;
6372
6373 procedure TKOLRichEdit.SetRE_AutoKeyboard(const Value: Boolean);
6374 begin
6375 asm
6376 jmp @@e_signature
6377 DB '#$signature$#', 0
6378 DB 'TKOLRichEdit.SetRE_AutoKeyboard', 0
6379 @@e_signature:
6380 end;
6381 FRE_AutoKeyboard := Value;
6382 Change;
6383 end;
6384
6385 procedure TKOLRichEdit.SetRE_AutoURLDetect(const Value: Boolean);
6386 begin
6387 asm
6388 jmp @@e_signature
6389 DB '#$signature$#', 0
6390 DB 'TKOLRichEdit.SetRE_AutoURLDetect', 0
6391 @@e_signature:
6392 end;
6393 FRE_AutoURLDetect := Value;
6394 Change;
6395 end;
6396
6397 procedure TKOLRichEdit.SetRE_DisableOverwriteChange(const Value: Boolean);
6398 begin
6399 asm
6400 jmp @@e_signature
6401 DB '#$signature$#', 0
6402 DB 'TKOLRichEdit.SetRE_DisableOverwriteChange', 0
6403 @@e_signature:
6404 end;
6405 FRE_DisableOverwriteChange := Value;
6406 Change;
6407 end;
6408
6409 procedure TKOLRichEdit.SetRE_FmtStandard(const Value: Boolean);
6410 begin
6411 asm
6412 jmp @@e_signature
6413 DB '#$signature$#', 0
6414 DB 'TKOLRichEdit.SetRE_FmtStandard', 0
6415 @@e_signature:
6416 end;
6417 FRE_FmtStandard := Value;
6418 Change;
6419 end;
6420
6421 procedure TKOLRichEdit.SetRE_Transparent(const Value: Boolean);
6422 begin
6423 asm
6424 jmp @@e_signature
6425 DB '#$signature$#', 0
6426 DB 'TKOLRichEdit.SetRE_Transparent', 0
6427 @@e_signature:
6428 end;
6429 FRE_Transparent := Value;
6430 Change;
6431 end;
6432
6433 procedure TKOLRichEdit.SetText(const Value: TStrings);
6434 begin
6435 asm
6436 jmp @@e_signature
6437 DB '#$signature$#', 0
6438 DB 'TKOLRichEdit.SetText', 0
6439 @@e_signature:
6440 end;
6441 FLines.Text := Value.Text;
6442 if Assigned(FKOLCtrl) then
6443 FKOLCtrl.Text:=Value.Text;
6444 Change;
6445 end;
6446
6447 procedure TKOLRichEdit.SetupFirst(SL: TStringList; const AName, AParent,
6448 Prefix: String);
6449 const
6450 BoolVal: array[ Boolean ] of String = ( 'FALSE', 'TRUE' );
6451 begin
6452 asm
6453 jmp @@e_signature
6454 DB '#$signature$#', 0
6455 DB 'TKOLRichEdit.SetupFirst', 0
6456 @@e_signature:
6457 end;
6458 inherited;
6459 if FLines.Text <> '' then
6460 AddLongTextField( SL, Prefix + AName + '.Text := ', FLines.Text, ';' );
6461 if MaxTextSize <> 32767 then
6462 if MaxTextSize > $7FFFffff then
6463 SL.Add( Prefix + AName + '.MaxTextSize := $' + Int2Hex( MaxTextSize, 8 ) + ';' )
6464 else
6465 SL.Add( Prefix + AName + '.MaxTextSize := ' + IntToStr( MaxTextSize ) + ';' );
6466 if RE_AutoKeybdSet then
6467 SL.Add( Prefix + AName + '.RE_AutoKeyboard := ' + BoolVal[ RE_AutoKeyboard ] + ';' );
6468 if RE_DisableOverwriteChange then
6469 SL.Add( Prefix + AName + '.RE_DisableOverwriteChange := TRUE;' );
6470 if RE_AutoURLDetect then
6471 SL.Add( Prefix + AName + '.RE_AutoURLDetect := TRUE;' );
6472 if RE_Transparent then
6473 SL.Add( Prefix + AName + '.RE_Transparent := TRUE;' );
6474 if Assigned( FpopupMenu ) then
6475 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
6476 ' );' );
6477 end;
6478
6479 function TKOLRichEdit.SetupParams(const AName, AParent: String): String;
6480 var S: String;
6481 begin
6482 asm
6483 jmp @@e_signature
6484 DB '#$signature$#', 0
6485 DB 'TKOLRichEdit.SetupParams', 0
6486 @@e_signature:
6487 end;
6488 S := 'eoMultiline';
6489 if eo_NoHScroll in Options then
6490 S := S + ', eoNoHScroll';
6491 if eo_NoVScroll in Options then
6492 S := S + ', eoNoVScroll';
6493 if eo_Lowercase in Options then
6494 S := S + ', eoLowercase';
6495 if eo_NoHideSel in Options then
6496 S := S + ', eoNoHideSel';
6497 if eo_OemConvert in Options then
6498 S := S + ', eoOemConvert';
6499 if eo_Password in Options then
6500 S := S + ', eoPassword';
6501 if eo_Readonly in Options then
6502 S := S + ', eoReadonly';
6503 if eo_UpperCase in Options then
6504 S := S + ', eoUpperCase';
6505 if eo_WantReturn in Options then
6506 S := S + ', eoWantReturn';
6507 if eo_WantTab in Options then
6508 S := S + ', eoWantTab';
6509 if S <> '' then
6510 if S[ 1 ] = ',' then
6511 S := Copy( S, 3, MaxInt );
6512 Result := AParent + ', [ ' + S + ' ]';
6513 end;
6514
6515 procedure TKOLRichEdit.Setversion(const Value: TKOLRichEditVersion);
6516 begin
6517 asm
6518 jmp @@e_signature
6519 DB '#$signature$#', 0
6520 DB 'TKOLRichEdit.Setversion', 0
6521 @@e_signature:
6522 end;
6523 Fversion := Value;
6524 Change;
6525 end;
6526
6527 function TKOLRichEdit.TabStopByDefault: Boolean;
6528 begin
6529 asm
6530 jmp @@e_signature
6531 DB '#$signature$#', 0
6532 DB 'TKOLRichEdit.TabStopByDefault', 0
6533 @@e_signature:
6534 end;
6535 Result := TRUE;
6536 end;
6537
6538 function TKOLRichEdit.TypeName: String;
6539 begin
6540 asm
6541 jmp @@e_signature
6542 DB '#$signature$#', 0
6543 DB 'TKOLRichEdit.TypeName', 0
6544 @@e_signature:
6545 end;
6546 Result := inherited TypeName;
6547 if version = ver1 then
6548 Result := 'RichEdit1';
6549 if OLESupport then
6550 Result := 'OLERichEdit';
6551 end;
6552
6553 procedure TKOLRichEdit.WantTabs( Want: Boolean );
6554 begin
6555 asm
6556 jmp @@e_signature
6557 DB '#$signature$#', 0
6558 DB 'TKOLRichEdit.WantTabs', 0
6559 @@e_signature:
6560 end;
6561 if Want then
6562 Options := Options + [ eo_WantTab ]
6563 else
6564 Options := Options - [ eo_WantTab ];
6565 end;
6566
6567 { TKOLProgressBar }
6568
6569 constructor TKOLProgressBar.Create(AOwner: TComponent);
6570 begin
6571 asm
6572 jmp @@e_signature
6573 DB '#$signature$#', 0
6574 DB 'TKOLProgressBar.Create', 0
6575 @@e_signature:
6576 end;
6577 inherited;
6578 Width := 300; DefaultWidth := Width;
6579 Height := 20; DefaultHeight := Height;
6580 MaxProgress := 100;
6581 ProgressColor := clHighLight;
6582 ProgressBkColor := clBtnFace;
6583 end;
6584
6585 procedure TKOLProgressBar.CreateKOLControl(Recreating: boolean);
6586 var
6587 opts: kol.TProgressbarOptions;
6588 begin
6589 opts:=[];
6590 if Smooth then
6591 Include(opts, kol.pboSmooth);
6592 if Vertical then
6593 Include(opts, kol.pboVertical);
6594 FKOLCtrl:=NewProgressbarEx(KOLParentCtrl, opts);
6595 end;
6596
6597 function TKOLProgressBar.GetColor: TColor;
6598 begin
6599 asm
6600 jmp @@e_signature
6601 DB '#$signature$#', 0
6602 DB 'TKOLProgressBar.GetColor', 0
6603 @@e_signature:
6604 end;
6605 Result := inherited Color;
6606 end;
6607
6608 procedure TKOLProgressBar.KOLControlRecreated;
6609 begin
6610 inherited;
6611 FKOLCtrl.Progress:=Progress;
6612 FKOLCtrl.MaxProgress:=MaxProgress;
6613 FKOLCtrl.ProgressBkColor:=ProgressBkColor;
6614 end;
6615
6616 function TKOLProgressBar.NoDrawFrame: Boolean;
6617 begin
6618 Result:=True;
6619 end;
6620
6621 procedure TKOLProgressBar.SetColor(const Value: TColor);
6622 begin
6623 asm
6624 jmp @@e_signature
6625 DB '#$signature$#', 0
6626 DB 'TKOLProgressBar.SetColor', 0
6627 @@e_signature:
6628 end;
6629 inherited Color := Value;
6630 end;
6631
6632 procedure TKOLProgressBar.SetMaxProgress(const Value: Integer);
6633 begin
6634 asm
6635 jmp @@e_signature
6636 DB '#$signature$#', 0
6637 DB 'TKOLProgressBar.SetMaxProgress', 0
6638 @@e_signature:
6639 end;
6640 if Value < 1 then Exit;
6641 FMaxProgress := Value;
6642 if Value < Progress then
6643 FProgress := Value;
6644 if Assigned(FKOLCtrl) then begin
6645 FKOLCtrl.MaxProgress:=FMaxProgress;
6646 FKOLCtrl.Progress:=FProgress;
6647 end;
6648 Change;
6649 end;
6650
6651 procedure TKOLProgressBar.SetpopupMenu(const Value: TKOLPopupMenu);
6652 begin
6653 asm
6654 jmp @@e_signature
6655 DB '#$signature$#', 0
6656 DB 'TKOLProgressBar.SetpopupMenu', 0
6657 @@e_signature:
6658 end;
6659 FpopupMenu := Value;
6660 Change;
6661 end;
6662
6663 procedure TKOLProgressBar.SetProgress(const Value: Integer);
6664 begin
6665 asm
6666 jmp @@e_signature
6667 DB '#$signature$#', 0
6668 DB 'TKOLProgressBar.SetProgress', 0
6669 @@e_signature:
6670 end;
6671 if Value < 0 then Exit;
6672 FProgress := Value;
6673 if Value > MaxProgress then
6674 FMaxProgress := Value;
6675 if Assigned(FKOLCtrl) then begin
6676 FKOLCtrl.MaxProgress:=FMaxProgress;
6677 FKOLCtrl.Progress:=FProgress;
6678 end;
6679 Change;
6680 end;
6681
6682 procedure TKOLProgressBar.SetProgressColor(const Value: TColor);
6683 begin
6684 asm
6685 jmp @@e_signature
6686 DB '#$signature$#', 0
6687 DB 'TKOLProgressBar.SetProgressColor', 0
6688 @@e_signature:
6689 end;
6690 FProgressColor := Value;
6691 if Assigned(FKOLCtrl) then
6692 FKOLCtrl.ProgressColor:=Value;
6693 Change;
6694 end;
6695
6696 procedure TKOLProgressBar.SetSmooth(const Value: Boolean);
6697 begin
6698 asm
6699 jmp @@e_signature
6700 DB '#$signature$#', 0
6701 DB 'TKOLProgressBar.SetSmooth', 0
6702 @@e_signature:
6703 end;
6704 FSmooth := Value;
6705 if Assigned(FKOLCtrl) then
6706 RecreateWnd;
6707 Change;
6708 end;
6709
6710 procedure TKOLProgressBar.SetupFirst(SL: TStringList; const AName, AParent,
6711 Prefix: String);
6712 begin
6713 asm
6714 jmp @@e_signature
6715 DB '#$signature$#', 0
6716 DB 'TKOLProgressBar.SetupFirst', 0
6717 @@e_signature:
6718 end;
6719 inherited;
6720 if MaxProgress <> 100 then
6721 SL.Add( Prefix + AName + '.MaxProgress := ' + IntToStr( MaxProgress ) + ';' );
6722 if Progress <> 0 then
6723 SL.Add( Prefix + AName + '.Progress := ' + IntToStr( Progress ) + ';' );
6724 if ProgressColor <> clHighLight then
6725 SL.Add( Prefix + AName + '.ProgressColor := ' + Color2Str( ProgressColor ) + ';' );
6726 {if ProgressBkColor <> clBtnFace then
6727 SL.Add( Prefix + AName + '.ProgressBkColor := ' + Color2Str( ProgressBkColor ) + ';' );}
6728 if Assigned( FpopupMenu ) then
6729 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
6730 ' );' );
6731 end;
6732
6733 function TKOLProgressBar.SetupParams(const AName, AParent: String): String;
6734 var S: String;
6735 begin
6736 asm
6737 jmp @@e_signature
6738 DB '#$signature$#', 0
6739 DB 'TKOLProgressBar.SetupParams', 0
6740 @@e_signature:
6741 end;
6742 Result := AParent;
6743 if Smooth or Vertical then
6744 begin
6745 S := '';
6746 if Smooth then
6747 S := 'pboSmooth';
6748 if Vertical then
6749 S := S + ', pboVertical';
6750 if S <> '' then
6751 if S[ 1 ] = ',' then
6752 S := Copy( S, 3, MaxInt );
6753 Result := Result + ', [ ' + S + ' ]';
6754 end;
6755 end;
6756
6757 procedure TKOLProgressBar.SetVertical(const Value: Boolean);
6758 begin
6759 asm
6760 jmp @@e_signature
6761 DB '#$signature$#', 0
6762 DB 'TKOLProgressBar.SetVertical', 0
6763 @@e_signature:
6764 end;
6765 FVertical := Value;
6766 if Assigned(FKOLCtrl) then
6767 RecreateWnd;
6768 Change;
6769 end;
6770
6771 function TKOLProgressBar.TypeName: String;
6772 begin
6773 asm
6774 jmp @@e_signature
6775 DB '#$signature$#', 0
6776 DB 'TKOLProgressBar.TypeName', 0
6777 @@e_signature:
6778 end;
6779 Result := inherited TypeName;
6780 if Smooth or Vertical then
6781 Result := 'ProgressBarEx';
6782 end;
6783
6784 { TKOLTabControl }
6785
6786 procedure TKOLTabControl.AdjustPages;
6787 var R: TRect;
6788 Dx, Dy: Integer;
6789 I: Integer;
6790 begin
6791 asm
6792 jmp @@e_signature
6793 DB '#$signature$#', 0
6794 DB 'TKOLTabControl.AdjustPages', 0
6795 @@e_signature:
6796 end;
6797 if Parent = nil then
6798 Exit;
6799 R := ClientRect;
6800 Inc( R.Left, 4 );
6801 Inc( R.Top, 4 );
6802 Dec( R.Right, 4 );
6803 Dec( R.Bottom, 4 );
6804 Dx := 0;
6805 Dy := 22;
6806 if tcoVertical in Options then
6807 begin
6808 Dx := 22;
6809 Dy := 0;
6810 end;
6811 if tcoBottom in Options then
6812 begin
6813 Dec( R.Right, Dx );
6814 Dec( R.Bottom, Dy );
6815 end
6816 else
6817 begin
6818 Inc( R.Left, Dx );
6819 Inc( R.Top, Dy );
6820 end;
6821 FAdjustingPages := TRUE;
6822 for I := 0 to Count-1 do
6823 begin
6824 Pages[ I ].FOnSetBounds := AttemptToChangePageBounds;
6825 Pages[ I ].BoundsRect := R;
6826 end;
6827 FAdjustingPages := FALSE;
6828 end;
6829
6830 procedure TKOLTabControl.AttemptToChangePageBounds(Sender: TObject;
6831 var NewBounds: TRect);
6832 begin
6833 asm
6834 jmp @@e_signature
6835 DB '#$signature$#', 0
6836 DB 'TKOLTabControl.AttemptToChangePageBounds', 0
6837 @@e_signature:
6838 end;
6839 if FAdjustingPages then Exit;
6840 if Count > 0 then
6841 begin
6842 AdjustPages;
6843 NewBounds := Pages[ 0 ].BoundsRect;
6844 end;
6845 end;
6846
6847 constructor TKOLTabControl.Create(AOwner: TComponent);
6848 begin
6849 asm
6850 jmp @@e_signature
6851 DB '#$signature$#', 0
6852 DB 'TKOLTabControl.Create', 0
6853 @@e_signature:
6854 end;
6855 inherited;
6856 Width := 100; DefaultWidth := Width;
6857 Height := 100; DefaultHeight := Height;
6858 FTabs := TList.Create;
6859 FedgeType := esNone;
6860 FgenerateConstants := TRUE;
6861 end;
6862
6863 destructor TKOLTabControl.Destroy;
6864 var I: Integer;
6865 begin
6866 asm
6867 jmp @@e_signature
6868 DB '#$signature$#', 0
6869 DB 'TKOLTabControl.Destroy', 0
6870 @@e_signature:
6871 end;
6872 fDestroyingTabControl := TRUE;
6873 for I := FTabs.Count-1 downto 0 do
6874 FreeMem( FTabs[ I ] );
6875 FTabs.Free;
6876 inherited;
6877 end;
6878
6879 function CompareTabPages( L: TList; e1, e2: DWORD ): Integer;
6880 var P1, P2: TKOLTabPage;
6881 begin
6882 asm
6883 jmp @@e_signature
6884 DB '#$signature$#', 0
6885 DB 'CompareTabPages', 0
6886 @@e_signature:
6887 end;
6888 P1 := L[ e1 ];
6889 P2 := L[ e2 ];
6890 if P1.TabOrder < P2.TabOrder then Result := -1
6891 else
6892 if P1.TabOrder > P2.TabOrder then Result := 1
6893 else
6894 Result := 0;
6895 end;
6896
6897 procedure SwapTabPages( L: TList; e1, e2: DWORD );
6898 var P: Pointer;
6899 begin
6900 asm
6901 jmp @@e_signature
6902 DB '#$signature$#', 0
6903 DB 'SwapTabPages', 0
6904 @@e_signature:
6905 end;
6906 P := L[ e1 ];
6907 L[ e1 ] := L[ e2 ];
6908 L[ e2 ] := P;
6909 end;
6910
6911 procedure TKOLTabControl.DoGenerateConstants(SL: TStringList);
6912 var I: Integer;
6913 C: TComponent;
6914 K: TKOLTabPage;
6915 Pages: TList;
6916 F: TForm;
6917 begin
6918 if not generateConstants then Exit;
6919 if Owner = nil then Exit;
6920 if not( Owner is TForm ) then Exit;
6921 F := Owner as TForm;
6922 Pages := TList.Create;
6923 TRY
6924 for I := 0 to F.ComponentCount-1 do
6925 begin
6926 C := F.Components[ I ];
6927 if not ( C is TKOLTabPage ) then CONTINUE;
6928 K := C as TKOLTabPage;
6929 if K.Parent <> Self then CONTINUE;
6930 Pages.Add( K );
6931 end;
6932 SortData( Pages, Pages.Count, @ CompareTabPages, @ SwapTabPages );
6933 for I := 0 to Pages.Count-1 do
6934 begin
6935 K := Pages[ I ];
6936 SL.Add( 'const _' + K.Name + ' = ' + IntToStr( I ) + ';' );
6937 end;
6938 FINALLY
6939 Pages.Free;
6940 END;
6941 end;
6942
6943 function TKOLTabControl.GetCount: Integer;
6944 var I: Integer;
6945 C: TComponent;
6946 K: TKOLTabPage;
6947 F: TForm;
6948 begin
6949 asm
6950 jmp @@e_signature
6951 DB '#$signature$#', 0
6952 DB 'TKOLTabControl.GetCount', 0
6953 @@e_signature:
6954 end;
6955 Result := 0;
6956 if Owner = nil then Exit;
6957 if not( Owner is TForm ) then Exit;
6958 F := Owner as TForm;
6959 for I := 0 to F.ComponentCount-1 do
6960 begin
6961 C := F.Components[ I ];
6962 if not ( C is TKOLTabPage ) then CONTINUE;
6963 K := C as TKOLTabPage;
6964 if K.Parent <> Self then CONTINUE;
6965 Inc( Result );
6966 end;
6967 end;
6968
6969 function TKOLTabControl.GetCurIndex: Integer;
6970 var I: Integer;
6971 CurPage: TKOLTabPage;
6972 begin
6973 asm
6974 jmp @@e_signature
6975 DB '#$signature$#', 0
6976 DB 'TKOLTabControl.GetCurIndex', 0
6977 @@e_signature:
6978 end;
6979 Result := -1;
6980 CurPage := GetCurrentPage;
6981 if CurPage = nil then Exit;
6982 for I := 0 to Count-1 do
6983 if CurPage = Pages[ I ] then
6984 begin
6985 Result := I;
6986 break;
6987 end;
6988 end;
6989
6990 function TKOLTabControl.GetCurrentPage: TKOLTabPage;
6991 var W: HWnd;
6992 C: TWinControl;
6993 begin
6994 asm
6995 jmp @@e_signature
6996 DB '#$signature$#', 0
6997 DB 'TKOLTabControl.GetCurrentPage', 0
6998 @@e_signature:
6999 end;
7000 Result := FCurPage;
7001 if Result = nil then
7002 begin
7003 W := GetWindow( Handle, GW_CHILD );
7004 if W = 0 then Exit;
7005 C := FindControl( W );
7006 if C is TKOLTabPage then
7007 begin
7008 Result := C as TKOLTabPage;
7009 FCurPage:=Result;
7010 end;
7011 end;
7012 {Result := nil;
7013 W := GetWindow( Handle, GW_CHILD );
7014 if W = 0 then Exit;
7015 C := FindControl( W );
7016 if C is TKOLTabPage then
7017 Result := C as TKOLTabPage;}
7018 end;
7019
7020 function TKOLTabControl.GetPages(Idx: Integer): TKOLTabPage;
7021 var I: Integer;
7022 C: TComponent;
7023 K: TKOLTabPage;
7024 F: TForm;
7025 L: TList;
7026 begin
7027 asm
7028 jmp @@e_signature
7029 DB '#$signature$#', 0
7030 DB 'TKOLTabControl.GetPages', 0
7031 @@e_signature:
7032 end;
7033 Result := nil;
7034 L := TList.Create;
7035 try
7036 if Owner = nil then Exit;
7037 if not( Owner is TForm ) then Exit;
7038 F := Owner as TForm;
7039 for I := 0 to F.ComponentCount-1 do
7040 begin
7041 C := F.Components[ I ];
7042 if not ( C is TKOLTabPage ) then CONTINUE;
7043 K := C as TKOLTabPage;
7044 if K.Parent <> Self then CONTINUE;
7045 L.Add( K );
7046 end;
7047 SortData( L, L.Count, @CompareTabPages, @SwapTabPages );
7048 Result := L.Items[ Idx ];
7049 finally
7050 L.Free;
7051 end;
7052 end;
7053
7054 function TKOLTabControl.NoDrawFrame: Boolean;
7055 begin
7056 Result := TRUE;
7057 end;
7058
7059 procedure TKOLTabControl.Paint;
7060 var
7061 R, CurR: TRect;
7062 I, Tw, Sx, Sy, W, H: Integer;
7063 S : String;
7064 CurPage: TKOLTabPage;
7065 M: PRect;
7066 DirXX_YY,DirXY_YX:SmallInt;
7067 O_V, O_B, O_BTN, O_F, O_BRD: Boolean;
7068 P:TPoint;
7069 Col: array[0..3] of TColor;
7070 Fnt: HFont;
7071
7072 procedure _MoveTo(const x,y:integer);
7073 begin
7074 p.x:=x;
7075 p.y:=y;
7076 canvas.moveto(x,y);
7077 end;
7078
7079 procedure MoveRel(const dx,dy:integer);
7080 begin
7081 p.x:=p.x+dirxx_yy*dx+dirxy_yx*dy;
7082 p.y:=p.y+dirxx_yy*dy+dirxy_yx*dx;
7083 canvas.moveto(p.x,p.y);
7084 end;
7085
7086 procedure LineRel(const dx,dy:integer);
7087 begin
7088 p.x:=p.x+dirxx_yy*dx+dirxy_yx*dy;
7089 p.y:=p.y+dirxx_yy*dy+dirxy_yx*dx;
7090 canvas.lineto(p.x,p.y);
7091 end;
7092
7093 procedure prepare(const r:trect);
7094 begin
7095 if o_v xor o_b then
7096 begin
7097 sy:=r.top;
7098 sx:=r.right;
7099 end else
7100 begin
7101 sy:=r.bottom;
7102 sx:=r.left;
7103 end;
7104 if o_v then
7105 begin
7106 h:=r.right-r.left;
7107 w:=r.bottom-r.top;
7108 end else
7109 begin
7110 w:=r.right-r.left;
7111 h:=r.bottom-r.top;
7112 end;
7113 if o_b then
7114 begin
7115 dec(sx);
7116 dec(sy);
7117 end;
7118 dec(h,2);
7119 end;
7120
7121 procedure DrawTab(r:trect; const cur:boolean);
7122 begin
7123 inflaterect(r,2,2);
7124 if o_btn then
7125 begin
7126 if not cur and o_f
7127 then drawedge(canvas.handle,r,BDR_RAISEDOUTER,BF_RECT or BF_SOFT)
7128 else drawedge(canvas.handle,r,EDGE_RAISED*succ(ord(cur)),BF_RECT or BF_SOFT);
7129 if cur then
7130 begin
7131 inflaterect(r,-2,-2);
7132 drawcaption(findwindow('Shell_TrayWnd',nil),canvas.handle,r,
7133 DC_TEXT or DC_ACTIVE or DC_INBUTTON);
7134 end;
7135 end else
7136 begin
7137 if cur then
7138 begin
7139 inflaterect(r,2,2);
7140 if o_b
7141 then if o_v then inc(r.left,2) else inc(r.top,2)
7142 else if o_v then dec(r.right,2) else dec(r.bottom,2);
7143 end;
7144 prepare(r);
7145 with canvas,r do
7146 begin
7147 if cur then
7148 begin
7149 _moveto(sx,sy);
7150 moverel(0,-2);
7151 pen.color:=clbtnface;
7152 linerel(w-3,0);
7153 linerel(0,1);
7154 linerel(4-w,0);
7155 end;
7156 _moveto(sx,sy);
7157 moverel(0,-2);
7158 pen.color:=col[0];
7159 linerel(0,2-h);
7160 linerel(2,-2);
7161 linerel(w-4,0);
7162 moverel(0,1);
7163 pen.color:=col[1];
7164 linerel(1,1);
7165 linerel(0,h-1);
7166 _moveto(sx,sy);
7167 moverel(1,-2);
7168 pen.color:=col[2];
7169 linerel(0,2-h);
7170 linerel(1,-1);
7171 linerel(w-4,0);
7172 moverel(0,1);
7173 pen.color:=col[3];
7174 linerel(0,h-1);
7175 end;
7176 end;
7177 end;
7178
7179 procedure preparefont;
7180 var
7181 a:integer;
7182 begin
7183 a:=900*pred(ord(not o_b) shl 1);
7184 fnt:=createfont(10,0,a,a,0,0,0,0,DEFAULT_CHARSET,OUT_DEFAULT_PRECIS,
7185 CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,VARIABLE_PITCH,'MS Serif');
7186 end;
7187
7188 begin
7189 asm
7190 jmp @@e_signature
7191 DB '#$signature$#', 0
7192 DB 'TKOLTabControl.Paint', 0
7193 @@e_signature:
7194 end;
7195 if PaintType = ptSchematic then
7196 begin
7197 SchematicPaint;
7198 Exit;
7199 end;
7200 o_b:=tcobottom in options;
7201 o_v:=tcovertical in options;
7202 o_btn:=tcobuttons in options;
7203 o_f:=tcoflat in options;
7204 o_brd:=tcoBorder in options;
7205 r:=clientrect;
7206 if o_brd then
7207 begin
7208 drawedge(canvas.handle,r,EDGE_SUNKEN,BF_RECT);
7209 inflaterect(r,-2,-2);
7210 end;
7211 inflaterect(r,-4,-4);
7212 if o_b
7213 then if o_v then r.left:=r.right-17 else r.top:=r.bottom-17
7214 else if o_v then r.right:=r.left+17 else r.bottom:=r.top+17;
7215 dirxx_yy:=ord(not o_v)*pred(ord(not o_b) shl 1);
7216 dirxy_yx:=ord(o_v)*pred(ord(not o_b) shl 1);
7217 col[0 xor ord(o_b)]:=clbtnhighlight;
7218 col[1 xor ord(o_b)]:=cl3ddkshadow;
7219 col[2 xor ord(o_b)]:=cl3dlight;
7220 col[3 xor ord(o_b)]:=clbtnshadow;
7221 if not o_v then PrepareCanvasFontForWYSIWIGPaint(canvas) else
7222 begin
7223 preparefont;
7224 selectobject(canvas.handle,fnt);
7225 end;
7226 curpage:=getcurrentpage;
7227 for i:=0 to pred(ftabs.count) do freemem(ftabs[i]);
7228 ftabs.clear;
7229 setbkmode(canvas.handle,windows.TRANSPARENT);
7230 for i:=0 to pred(count) do
7231 begin
7232 getmem(m,sizeof(trect));
7233 s:=pages[i].caption;
7234 tw:=canvas.textwidth(s);
7235 if o_v then r.bottom:=r.top+tw+8 else r.right:=r.left+tw+8;
7236 m^:=r;
7237 ftabs.add(m);
7238 if curpage=pages[i] then curr:=r else
7239 begin
7240 drawtab(r,false);
7241 drawtext(canvas.handle,pchar(s),length(s),r,DT_CENTER or DT_VCENTER or DT_SINGLELINE);
7242 end;
7243 pages[i].fonsetbounds:=attempttochangepagebounds;
7244 if o_v then r.top:=r.bottom+4 else r.left:=r.right+4;
7245 if o_btn then
7246 if o_v then inc(r.top,2) else inc(r.left,2);
7247 end;
7248 r:=clientrect;
7249 if o_brd then inflaterect(r,-2,-2);
7250 if o_b
7251 then if o_v then r.right:=r.right-21 else r.bottom:=r.bottom-21
7252 else if o_v then r.left:=r.left+21 else r.top:=r.top+21;
7253 if not o_btn then drawedge(canvas.handle,r,EDGE_RAISED,BF_RECT or BF_SOFT);
7254 if curpage<>nil then
7255 begin
7256 drawtab(curr,true);
7257 s:=curpage.caption;
7258 if o_btn then offsetrect(curr,2,2) else offsetrect(curr,-2*dirxy_yx,-2*dirxx_yy);
7259 drawtext(canvas.handle,pchar(s),length(s),curr,DT_CENTER or DT_VCENTER or DT_SINGLELINE);
7260 end;
7261 if o_v then deleteobject(fnt);
7262 inherited;
7263 end;
7264
7265 procedure TKOLTabControl.SchematicPaint;
7266 var R: TRect;
7267 I, Tw, Th: Integer;
7268 S: String;
7269 CurPage: TKOLTabPage;
7270 M: PRect;
7271 begin
7272 asm
7273 jmp @@e_signature
7274 DB '#$signature$#', 0
7275 DB 'TKOLTabControl.Paint', 0
7276 @@e_signature:
7277 end;
7278 inherited Paint;
7279 R := ClientRect;
7280 Inc( R.Top, 4 );
7281 Inc( R.Left, 4 );
7282 Dec( R.Right, 4 );
7283 Dec( R.Bottom, 4 );
7284 if tcoBottom in Options then
7285 if tcoVertical in Options then
7286 R.Left := R.Right - 18
7287 else
7288 R.Top := R.Bottom - 18
7289 else
7290 if tcoVertical in Options then
7291 R.Right := R.Left + 18
7292 else
7293 R.Bottom := R.Top + 18;
7294 R.Right := R.Left + 18;
7295 R.Bottom := R.Top + 18;
7296 Canvas.Font.Height := 8;
7297 Canvas.Brush.Color := clDkGray;
7298 CurPage := GetCurrentPage;
7299 for I := 0 to FTabs.Count-1 do
7300 FreeMem( FTabs[ I ] );
7301 FTabs.Clear;
7302 for I := 0 to Count-1 do
7303 begin
7304 GetMem( M, SizeOf( TRect ) );
7305 M^ := R;
7306 FTabs.Add( M );
7307 S := IntToStr( I );
7308 Tw := Canvas.TextWidth( S );
7309 Th := Canvas.TextHeight( S );
7310 Canvas.TextRect( R, R.Left + (18 - Tw) div 2, R.Top + (18 - Th) div 2, S );
7311 Pages[ I ].FOnSetBounds := AttemptToChangePageBounds;
7312 if CurPage = Pages[ I ] then
7313 begin
7314 Canvas.Brush.Color := clBlack;
7315 Canvas.FrameRect( R );
7316 Canvas.Brush.Color := clDkGray;
7317 end;
7318 if tcoVertical in Options then
7319 begin
7320 Inc( R.Top, 22 );
7321 Inc( R.Bottom, 22 );
7322 end
7323 else
7324 begin
7325 Inc( R.Left, 22 );
7326 Inc( R.Right, 22 );
7327 end;
7328 end;
7329 end;
7330
7331 procedure TKOLTabControl.SetBounds(aLeft, aTop, aWidth, aHeight: Integer);
7332 begin
7333 asm
7334 jmp @@e_signature
7335 DB '#$signature$#', 0
7336 DB 'TKOLTabControl.SetBounds', 0
7337 @@e_signature:
7338 end;
7339 inherited;
7340 AdjustPages;
7341 end;
7342
7343 procedure TKOLTabControl.SetCount(const Value: Integer);
7344 var Pg: TKOLTabPage;
7345 I: Integer;
7346 S: String;
7347 begin
7348 asm
7349 jmp @@e_signature
7350 DB '#$signature$#', 0
7351 DB 'TKOLTabControl.SetCount', 0
7352 @@e_signature:
7353 end;
7354 if Value < Count then Exit;
7355 if csLoading in ComponentState then Exit;
7356 I := Count;
7357 while Value > Count do
7358 begin
7359 while True do
7360 begin
7361 S := Name + '_Tab' + IntToStr( I );
7362 if (Owner as TForm).FindComponent( S ) = nil then
7363 break;
7364 Inc( I );
7365 end;
7366 Pg := TKOLTabPage.Create( Owner );
7367 Pg.Parent := Self;
7368 Pg.Name := S;
7369 Pg.Caption := 'Tab' + IntToStr( I );
7370 //Pg.BevelOuter := bvNone;
7371 Pg.edgeStyle := esNone;
7372 //Pg.Align := caClient;
7373 Inc( I );
7374 end;
7375 AdjustPages;
7376 Invalidate;
7377 Change;
7378 end;
7379
7380 procedure TKOLTabControl.SetCurIndex(const Value: Integer);
7381 //var Pg: TKOLTabPage;
7382 begin
7383 asm
7384 jmp @@e_signature
7385 DB '#$signature$#', 0
7386 DB 'TKOLTabControl.SetCurIndex', 0
7387 @@e_signature:
7388 end;
7389 if (Value >= Count) or (Value < 0) then
7390 begin
7391 FCurPage := nil;
7392 Exit;
7393 end;
7394 FCurPage:=Pages[ Value ];
7395 if FCurPage <> nil then
7396 begin
7397 FCurPage.BringToFront;
7398 Invalidate;
7399 end;
7400 {Pg := Pages[ Value ];
7401 if Pg <> nil then
7402 begin
7403 Pg.BringToFront;
7404 Invalidate;
7405 end;}
7406 Change;
7407 end;
7408
7409 procedure TKOLTabControl.SetedgeType(const Value: TEdgeStyle);
7410 begin
7411 asm
7412 jmp @@e_signature
7413 DB '#$signature$#', 0
7414 DB 'TKOLTabControl.SetedgeType', 0
7415 @@e_signature:
7416 end;
7417 FedgeType := Value;
7418 if Value = esNone then
7419 Options := Options - [ tcoBorder ]
7420 else
7421 Options := Options + [ tcoBorder ];
7422 Change;
7423 end;
7424
7425 procedure TKOLTabControl.SetgenerateConstants(const Value: Boolean);
7426 begin
7427 FgenerateConstants := Value;
7428 Change;
7429 end;
7430
7431 procedure TKOLTabControl.SetImageList(const Value: TKOLImageList);
7432 begin
7433 asm
7434 jmp @@e_signature
7435 DB '#$signature$#', 0
7436 DB 'TKOLTabControl.SetImageList', 0
7437 @@e_signature:
7438 end;
7439 FImageList := Value;
7440 Change;
7441 end;
7442
7443 procedure TKOLTabControl.SetImageList1stIdx(const Value: Integer);
7444 begin
7445 asm
7446 jmp @@e_signature
7447 DB '#$signature$#', 0
7448 DB 'TKOLTabControl.SetImageList1stIdx', 0
7449 @@e_signature:
7450 end;
7451 FImageList1stIdx := Value;
7452 Change;
7453 end;
7454
7455 procedure TKOLTabControl.SetOptions(const Value: TTabControlOptions);
7456 begin
7457 asm
7458 jmp @@e_signature
7459 DB '#$signature$#', 0
7460 DB 'TKOLTabControl.SetOptions', 0
7461 @@e_signature:
7462 end;
7463 FOptions := Value;
7464 AdjustPages;
7465 Invalidate;
7466 Change;
7467 end;
7468
7469 procedure TKOLTabControl.SetpopupMenu(const Value: TKOLPopupMenu);
7470 begin
7471 asm
7472 jmp @@e_signature
7473 DB '#$signature$#', 0
7474 DB 'TKOLTabControl.SetpopupMenu', 0
7475 @@e_signature:
7476 end;
7477 FpopupMenu := Value;
7478 Change;
7479 end;
7480
7481 procedure TKOLTabControl.SetupFirst(SL: TStringList; const AName, AParent,
7482 Prefix: String);
7483 begin
7484 asm
7485 jmp @@e_signature
7486 DB '#$signature$#', 0
7487 DB 'TKOLTabControl.SetupFirst', 0
7488 @@e_signature:
7489 end;
7490 inherited;
7491 case edgeType of
7492 esLowered:;
7493 esRaised: SL.Add( Prefix + AName + '.Style := ' + AName +
7494 '.Style or WS_THICKFRAME;' );
7495 esNone: ;
7496 end;
7497 if Assigned( FpopupMenu ) then
7498 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
7499 ' );' );
7500 end;
7501
7502 procedure TKOLTabControl.SetupLast(SL: TStringList; const AName, AParent,
7503 Prefix: String);
7504 begin
7505 asm
7506 jmp @@e_signature
7507 DB '#$signature$#', 0
7508 DB 'TKOLTabControl.SetupLast', 0
7509 @@e_signature:
7510 end;
7511 inherited;
7512 if CurIndex > 0 then
7513 begin
7514 //SL.Add( Prefix + ' ' + AName + '.GetWindowHandle;' );
7515 //SL.Add( Prefix + ' ' + AName + '.CreateWindow;' );
7516 SL.Add( Prefix + ' ' + AName + '.CurIndex := ' + IntToStr( CurIndex ) + ';' );
7517 //SL.Add( Prefix + ' PostMessage( ' + AName + '.GetWindowHandle, TCM_SETCURSEL, ' + IntToStr( CurIndex ) +
7518 // ', 0 );' );
7519 SL.Add( Prefix + ' ' + AName + '.Pages[ ' + IntToStr( CurIndex ) + ' ].BringToFront;' );
7520 end;
7521 end;
7522
7523 function TKOLTabControl.SetupParams(const AName, AParent: String): String;
7524 var O, IL, S: String;
7525 I: Integer;
7526 begin
7527 asm
7528 jmp @@e_signature
7529 DB '#$signature$#', 0
7530 DB 'TKOLTabControl.SetupParams', 0
7531 @@e_signature:
7532 end;
7533 S := '';
7534 for I := 0 to Count - 1 do
7535 begin
7536 if S <> '' then
7537 S := S + ', ';
7538 S := S + StringConstant( 'Page' + IntToStr( I ) + 'Caption', Pages[ I ].Caption );
7539 end;
7540 O := '';
7541 if tcoButtons in Options then
7542 O := 'tcoButtons';
7543 if tcoFixedWidth in Options then
7544 O := O + ', tcoFixedWidth';
7545 if tcoFocusTabs in Options then
7546 O := O + ', tcoFocusTabs';
7547 if tcoIconLeft in Options then
7548 O := O + ', tcoIconLeft';
7549 if tcoLabelLeft in Options then
7550 O := O + ', tcoLabelLeft';
7551 if tcoMultiline in Options then
7552 O := O + ', tcoMultiline';
7553 if tcoMultiselect in Options then
7554 O := O + ', tcoMultiselect';
7555 if tcoFitRows in Options then
7556 O := O + ', tcoFitRows';
7557 if tcoScrollOpposite in Options then
7558 O := O + ', tcoScrollOpposite';
7559 if tcoBottom in Options then
7560 O := O + ', tcoBottom';
7561 if tcoVertical in Options then
7562 O := O + ', tcoVertical';
7563 if tcoFlat in Options then
7564 O := O + ', tcoFlat';
7565 if tcoHotTrack in Options then
7566 O := O + ', tcoHotTrack';
7567 if tcoBorder in Options then
7568 O := O + ', tcoBorder';
7569 if tcoOwnerDrawFixed in Options then
7570 O := O + ', tcoOwnerDrawFixed';
7571 if O <> '' then
7572 if O[ 1 ] = ',' then
7573 O := Copy( O, 3, MaxInt );
7574 IL := 'nil';
7575 if ImageList <> nil then
7576 IL := 'Result.' + ImageList.Name;
7577 Result := AParent + ', [ ' + S + ' ], [ ' + O + ' ], ' + IL
7578 + ', ' + IntToStr( ImageList1stIdx );
7579 end;
7580
7581 function TKOLTabControl.TabStopByDefault: Boolean;
7582 begin
7583 asm
7584 jmp @@e_signature
7585 DB '#$signature$#', 0
7586 DB 'TKOLTabControl.TabStopByDefault', 0
7587 @@e_signature:
7588 end;
7589 Result := TRUE;
7590 end;
7591
7592 function TKOLTabControl.WYSIWIGPaintImplemented: Boolean;
7593 begin
7594 Result := TRUE;
7595 end;
7596
7597 { TKOLToolbar }
7598
7599 function TKOLToolbar.AllPicturedButtonsAreLeading: Boolean;
7600 var I: Integer;
7601 Bt: TKOLToolbarButton;
7602 begin
7603 Result := FALSE;
7604 if PicturedButtonsCount = 0 then Exit;
7605 Bt := Items[ 0 ];
7606 if not Bt.HasPicture then Exit;
7607 Result := TRUE;
7608 for I := 0 to Items.Count-1 do
7609 begin
7610 Bt := Items[ I ];
7611 if not Bt.HasPicture then
7612 begin
7613 if NoMorePicturedButtonsFrom( I ) then
7614 break;
7615 Result := FALSE;
7616 break;
7617 end;
7618 end;
7619 end;
7620
7621 function TKOLToolbar.LastBtnHasPicture: Boolean;
7622 var Bt: TKOLToolbarButton;
7623 begin
7624 Result := FALSE;
7625 if PicturedButtonsCount = 0 then Exit;
7626 if not Assigned( Items ) then Exit;
7627 if Items.Count = 0 then Exit;
7628 Bt := Items[ Items.Count-1 ];
7629 Result := Bt.HasPicture;
7630 end;
7631
7632 procedure TKOLToolbar.AssembleBitmap;
7633 var MaxWidth, MaxHeight: Integer;
7634 I: Integer;
7635 Bt: TKOLToolbarButton;
7636 TranColor: TColor;
7637 TmpBmp: TBitmap;
7638 begin
7639 asm
7640 jmp @@e_signature
7641 DB '#$signature$#', 0
7642 DB 'TKOLToolbar.AssembleBitmap', 0
7643 @@e_signature:
7644 end;
7645 MaxWidth := 0;
7646 MaxHeight := 0;
7647 TranColor := clNone;
7648 for I := 0 to Items.Count-1 do
7649 begin
7650 Bt := Items[ I ];
7651 if Bt.HasPicture then
7652 begin
7653 if MaxWidth < Bt.picture.Width then
7654 MaxWidth := Bt.picture.Width;
7655 if MaxHeight < Bt.picture.Height then
7656 MaxHeight := Bt.picture.Height;
7657 if TranColor = clNone then
7658 begin
7659 TmpBmp := TBitmap.Create;
7660 TRY
7661 TmpBmp.Width := Bt.picture.Width;
7662 TmpBmp.Height := Bt.picture.Height;
7663 TmpBmp.Canvas.Draw( 0, 0, Bt.picture.Graphic );
7664 TranColor := TmpBmp.Canvas.Pixels[ 0, TmpBmp.Height - 1 ];
7665 FINALLY
7666 TmpBmp.Free;
7667 END;
7668 end;
7669 end;
7670 end;
7671 if (MaxWidth = 0) or (MaxHeight = 0) then
7672 begin
7673 Fbitmap.Width := 0;
7674 Fbitmap.Height := 0;
7675 end
7676 else
7677 begin
7678 Fbitmap.Width := MaxWidth * Items.Count;
7679 Fbitmap.Height := MaxHeight;
7680 if TranColor <> clNone then
7681 begin
7682 Fbitmap.Canvas.Brush.Color := TranColor;
7683 Fbitmap.Canvas.FillRect( Rect( 0, 0, Fbitmap.Width, Fbitmap.Height ) );
7684 end;
7685 for I := 0 to Items.Count - 1 do
7686 begin
7687 Bt := Items[ I ];
7688 if Bt.HasPicture then
7689 Fbitmap.Canvas.Draw( I * MaxWidth, 0, Bt.picture.Graphic );
7690 end;
7691 end;
7692 if ActiveDesign <> nil then
7693 begin
7694 ActiveDesign.Bitmap.Assign( Fbitmap );
7695 ActiveDesign.ApplyImages;
7696 end;
7697 if Assigned(FKOLCtrl) then
7698 RecreateWnd;
7699 end;
7700
7701 function IsBitmapEmpty( Bmp: TBitmap ): Boolean;
7702 var //TmpBmp: TBitmap;
7703 Y, X: Integer;
7704 Color1: TColor;
7705 Lin: PDWORD;
7706 KOLBmp: KOL.PBitmap;
7707 begin
7708 asm
7709 jmp @@e_signature
7710 DB '#$signature$#', 0
7711 DB 'IsBitmapEmpty', 0
7712 @@e_signature:
7713 end;
7714 Result := TRUE;
7715 if not Assigned( Bmp ) then Exit;
7716 if Bmp.Width * Bmp.Height = 0 then Exit;
7717 KOLBmp := NewBitmap( Bmp.Width, Bmp.Height );
7718 TRY
7719
7720 KOLBmp.HandleType := KOL.bmDIB;
7721 KOLBmp.PixelFormat := KOL.pf32bit;
7722 BitBlt( KOLBmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height,
7723 Bmp.Canvas.Handle, 0, 0, SrcCopy );
7724 Lin := KOLBmp.ScanLine[ 0 ];
7725 if Lin = nil then
7726 begin
7727 Result := FALSE;
7728 Exit;
7729 end;
7730 Color1 := Lin^ and $FFFFFF;
7731 for Y := 0 to KOLBmp.Height-1 do
7732 begin
7733 Lin := KOLBmp.ScanLine[ Y ];
7734 for X := 0 to KOLBmp.Width-1 do
7735 begin
7736 if DWORD(Lin^ and $FFFFFF) <> DWORD( Color1 ) then
7737 begin
7738 Result := FALSE;
7739 Exit;
7740 end;
7741 Inc( Lin );
7742 end;
7743 end;
7744 FINALLY
7745 KOLBmp.Free;
7746 END;
7747 end;
7748
7749 procedure TKOLToolbar.AssembleTooltips;
7750 var SL: TStringList;
7751 I, N: Integer;
7752 Bt: TKOLToolbarButton;
7753 begin
7754 asm
7755 jmp @@e_signature
7756 DB '#$signature$#', 0
7757 DB 'TKOLToolbar.AssembleTooltips', 0
7758 @@e_signature:
7759 end;
7760 N := 0;
7761 SL := TStringList.Create;
7762 TRY
7763 for I := 0 to Items.Count-1 do
7764 begin
7765 Bt := Items[ I ];
7766 if Bt.separator then continue;
7767 SL.Add( Bt.Ftooltip );
7768 if Length( Bt.Ftooltip ) > 0 then
7769 Inc( N );
7770 end;
7771 if N = 0 then
7772 SL.Clear;
7773 tooltips := SL;
7774 showTooltips := SL.Count > 0;
7775 FINALLY
7776 SL.Free;
7777 END;
7778 end;
7779
7780 procedure TKOLToolbar.bitmap2ItemPictures( AnyWay: Boolean );
7781 var W, I: Integer;
7782 Bmp: TBitmap;
7783 Bt: TKOLToolbarButton;
7784 Format: TPixelFormat;
7785 KOLBmp: KOL.PBitmap;
7786 begin
7787 asm
7788 jmp @@e_signature
7789 DB '#$signature$#', 0
7790 DB 'TKOLToolbar.bitmap2ItemPictures', 0
7791 @@e_signature:
7792 end;
7793 if not Assigned( bitmap ) then Exit;
7794 if Items.Count = 0 then Exit;
7795 if bitmap.Width = 0 then Exit;
7796 if bitmap.Height = 0 then Exit;
7797 if not AnyWay then
7798 begin
7799 for I := 0 to Items.Count - 1 do
7800 begin
7801 Bt := Items[ I ];
7802 if Bt.HasPicture then
7803 Exit;
7804 end;
7805 ShowMessage( 'Restoring toolbar buttons bitmap from then previous version of the KOL&MCK format.' );
7806 end;
7807 W := bitmap.Width div Items.Count;
7808 Bmp := TBitmap.Create;
7809 KOLBmp := NewDIBBitmap( Bitmap.Width, Bitmap.Height, KOL.pf32bit );
7810 TRY
7811 BitBlt( KOLBmp.Canvas.Handle, 0, 0, bitmap.Width, bitmap.Height,
7812 bitmap.Canvas.Handle, 0, 0, SRCCOPY );
7813 KOLBmp.HandleType := KOL.bmDIB;
7814 KOLBmp.PixelFormat := KOL.pf32bit;
7815 case CountSystemColorsUsedInBitmap( KOLBmp ) of
7816 KOL.pf1bit: Format := pf1bit;
7817 KOL.pf4bit: Format := pf4bit;
7818 KOL.pf8bit: Format := pf8bit;
7819 else Format := pf24bit;
7820 end;
7821 FINALLY
7822 KOLBmp.Free;
7823 END;
7824 TRY
7825 Bmp.Width := W;
7826 Bmp.Height := bitmap.Height;
7827 {$IFNDEF _D2}
7828 Bmp.PixelFormat := Format;
7829 {$ENDIF}
7830 for I := 0 to Items.Count - 1 do
7831 begin
7832 if I >= Items.Count then break;
7833 if Items[ I ] = nil then break;
7834 Bmp.Canvas.CopyRect( Rect( 0, 0, Bmp.Width, Bmp.Height ),
7835 bitmap.Canvas,
7836 Rect( I * Bmp.Width, 0, (I + 1) * Bmp.Width, Bmp.Height ) );
7837 Bt := Items[ I ];
7838 if IsBitmapEmpty( Bmp ) then
7839 begin
7840 Bt.Fpicture.Free;
7841 Bt.Fpicture := TPicture.Create;
7842 end
7843 else
7844 begin
7845 Bt.Fpicture.Assign( Bmp );
7846 end;
7847 end;
7848 FINALLY
7849 Bmp.Free;
7850 END;
7851 end;
7852
7853 procedure TKOLToolbar.buttons2Items;
7854 var I, J: Integer;
7855 S, C: String;
7856 Bt: TKOLToolbarButton;
7857 begin
7858 asm
7859 jmp @@e_signature
7860 DB '#$signature$#', 0
7861 DB 'TKOLToolbar.buttons2Items', 0
7862 @@e_signature:
7863 end;
7864 S := buttons;
7865 J := 0;
7866 while S <> '' do
7867 begin
7868 I := pos( #1, S );
7869 if I > 0 then
7870 begin
7871 C := Copy( S, 1, I - 1 );
7872 S := Copy( S, I + 1, MaxInt );
7873 end
7874 else
7875 begin
7876 C := S;
7877 S := '';
7878 end;
7879 if J >= Items.Count then
7880 Bt := TKOLToolbarButton.Create( Self )
7881 else
7882 Bt := Items[ J ];
7883 if C <> '' then
7884 if C[ 1 ] = '^' then
7885 begin
7886 C := Copy( C, 2, MaxInt );
7887 Bt.Fdropdown := TRUE;
7888 end;
7889 Bt.Fcaption := C;
7890 if C <> '-' then
7891 Bt.Fseparator := FALSE;
7892 Inc( J );
7893 end;
7894 bitmap2ItemPictures( FALSE );
7895 end;
7896
7897 procedure TKOLToolbar.Change;
7898 begin
7899 asm
7900 jmp @@e_signature
7901 DB '#$signature$#', 0
7902 DB 'TKOLToolbar.Change', 0
7903 @@e_signature:
7904 end;
7905 inherited;
7906 if ActiveDesign <> nil then
7907 ActiveDesign.RefreshItems;
7908 if ParentForm <> nil then
7909 if ParentForm.Designer <> nil then
7910 ParentForm.Designer.Modified;
7911 end;
7912
7913 constructor TKOLToolbar.Create(AOwner: TComponent);
7914 begin
7915 asm
7916 jmp @@e_signature
7917 DB '#$signature$#', 0
7918 DB 'TKOLToolbar.Create', 0
7919 @@e_signature:
7920 end;
7921 Ftooltips := TStringList.Create;
7922 inherited;
7923 FFixFlatXP := TRUE;
7924 FgenerateConstants := TRUE;
7925 FHeightAuto := TRUE;
7926 Fitems := TList.Create;
7927 ControlStyle := ControlStyle + [ csAcceptsControls ];
7928 Height := 22; DefaultHeight := Height;
7929 Width := 400;
7930 DefaultWidth := 400;
7931 Align := caTop;
7932 FBitmap := TBitmap.Create;
7933 {$IFNDEF VER90}
7934 FmapBitmapColors := TRUE;
7935 {$ENDIF}
7936 FHasBorder := FALSE;
7937 FDefHasBorder := FALSE;
7938 FTimer := TTimer.Create( Self );
7939 FTimer.Interval := 200;
7940 FTimer.OnTimer := Tick;
7941 FTimer.Enabled := TRUE;
7942 AllowPostPaint := True;
7943 end;
7944
7945 procedure TKOLToolbar.DefineProperties(Filer: TFiler);
7946 var I: Integer;
7947 Bt: TKOLToolbarButton;
7948 begin
7949 asm
7950 jmp @@e_signature
7951 DB '#$signature$#', 0
7952 DB 'TKOLToolbar.DefineProperties', 0
7953 @@e_signature:
7954 end;
7955 inherited;
7956 Filer.DefineProperty( 'Buttons_Count', LoadButtonCount, SaveButtonCount, TRUE );
7957 for I := 0 to FButtonCount-1 do
7958 begin
7959 if FItems.Count <= I then
7960 Bt := TKOLToolbarButton.Create( Self )
7961 else
7962 Bt := FItems[ I ];
7963 //Bt.DefineProperties( Filer );
7964 Bt.DefProps( 'Btn' + IntToStr( I + 1 ), Filer );
7965 end;
7966 Filer.DefineProperty( 'NewVersion', ReadNewVersion, WriteNewVersion, fNewVersion );
7967 end;
7968
7969 destructor TKOLToolbar.Destroy;
7970 var I: Integer;
7971 begin
7972 asm
7973 jmp @@e_signature
7974 DB '#$signature$#', 0
7975 DB 'TKOLToolbar.Destroy', 0
7976 @@e_signature:
7977 end;
7978 for I := FItems.Count-1 downto 0 do
7979 TObject( FItems[ I ] ).Free;
7980 FItems.Free;
7981 FTimer.Free;
7982 ActiveDesign.Free;
7983 FBitmap.Free;
7984 FBitmap := nil;
7985 Ftooltips.Free;
7986 {if FKOLCtrl <> nil then
7987 begin
7988 FKOLCtrl.Free;
7989 FKOLCtrl := nil;
7990 end;}
7991 if FBmpDesign <> 0 then
7992 DeleteObject( FBmpDesign );
7993 inherited;
7994 end;
7995
7996 function IsNumber( const S: String ): Boolean;
7997 var I: Integer;
7998 begin
7999 Result := FALSE;
8000 if S = '' then Exit;
8001 for I := 1 to Length( S ) do
8002 if not( S[ I ] in [ '0'..'9' ] ) then
8003 Exit;
8004 Result := TRUE;
8005 end;
8006
8007 procedure TKOLToolbar.DoGenerateConstants(SL: TStringList);
8008 var I, N, K: Integer;
8009 Bt: TKOLToolbarButton;
8010 begin
8011 if not (generateConstants or generateVariables) then Exit;
8012 N := 0;
8013 K := 0;
8014 for I := 0 to Items.Count-1 do
8015 begin
8016 Bt := Items[ I ];
8017 if Bt.separator and (Copy( Bt.Name, 1, 2 ) = 'TB') and
8018 IsNumber( Copy( Bt.Name, 3, MaxInt ) ) then
8019 begin
8020 Inc( N );
8021 continue;
8022 end;
8023 if Bt.Name <> '' then
8024 begin
8025 if generateConstants then
8026 SL.Add( 'const ' + Bt.Name + ' = ' + IntToStr( N ) + ';' )
8027 else
8028 SL.Add( 'var ' + Bt.Name + ' = ' + IntToStr( N ) + ';' );
8029 Inc( K );
8030 end;
8031 Inc( N );
8032 end;
8033 if ( K > 0 ) then
8034 SL.Add( '' );
8035 end;
8036
8037 function TKOLToolbar.GetButtons: String;
8038 begin
8039 Result := Fbuttons;
8040 if Items.Count = 0 then Exit;
8041 Items2buttons;
8042 Result := FButtons;
8043 end;
8044
8045 procedure TKOLToolbar.Items2buttons;
8046 var I: Integer;
8047 S: String;
8048 Bt: TKOLToolbarButton;
8049 begin
8050 asm
8051 jmp @@e_signature
8052 DB '#$signature$#', 0
8053 DB 'TKOLToolbar.Items2buttons', 0
8054 @@e_signature:
8055 end;
8056 S := '';
8057 for I := 0 to Items.Count-1 do
8058 begin
8059 Bt := Items[ I ];
8060 if S <> '' then
8061 S := S + #1;
8062 if Bt.dropdown then
8063 S := S + '^';
8064 S := S + Bt.caption;
8065 end;
8066 buttons := S;
8067 end;
8068
8069 procedure TKOLToolbar.LoadButtonCount(R: TReader);
8070 begin
8071 asm
8072 jmp @@e_signature
8073 DB '#$signature$#', 0
8074 DB 'TKOLToolbar.LoadButtonCount', 0
8075 @@e_signature:
8076 end;
8077 FButtonCount := R.ReadInteger;
8078 //ShowMessage( 'loaded FButtonCount=' + IntToStr( FButtonCount ) );
8079 end;
8080
8081 procedure TKOLToolbar.Loaded;
8082 var I, J: Integer;
8083 Bt: TKOLToolbarButton;
8084 S: String;
8085 AnyEnabled: Boolean;
8086 begin
8087 asm
8088 jmp @@e_signature
8089 DB '#$signature$#', 0
8090 DB 'TKOLToolbar.Loaded', 0
8091 @@e_signature:
8092 end;
8093 inherited;
8094 buttons2Items;
8095 AnyEnabled := FALSE;
8096 for I := 0 to Items.Count-1 do
8097 begin
8098 Bt := Items[ I ];
8099 if Bt.Name = '' then
8100 begin
8101 for J := 1 to MaxInt do
8102 begin
8103 S := 'TB' + IntToStr( J );
8104 if (FindComponent( S ) = nil) and ((Owner as TForm).FindComponent( S ) = nil) then
8105 begin
8106 Bt.Name := S;
8107 break;
8108 end;
8109 end;
8110 end;
8111 if Bt.enabled then
8112 AnyEnabled := TRUE;
8113 end;
8114 if not AnyEnabled then
8115 begin
8116 for I := 0 to Items.Count-1 do
8117 begin
8118 Bt := Items[ I ];
8119 Bt.enabled := TRUE;
8120 end;
8121 end;
8122 fNewVersion := TRUE;
8123 if Assigned(FKOLCtrl) then
8124 if StandardImagesUsed > 0 then
8125 RecreateWnd
8126 else
8127 UpdateButtons;
8128 end;
8129
8130 function TKOLToolbar.MaxBtnImgHeight: Integer;
8131 var I: Integer;
8132 Bt: TKOLToolbarButton;
8133 begin
8134 asm
8135 jmp @@e_signature
8136 DB '#$signature$#', 0
8137 DB 'TKOLToolbar.MaxBtnImgHeight', 0
8138 @@e_signature:
8139 end;
8140 Result := 0;
8141 for I := 0 to Items.Count-1 do
8142 begin
8143 Bt := Items[ I ];
8144 if Bt.HasPicture and (Bt.picture.Height > Result) then
8145 Result := Bt.picture.Height;
8146 end;
8147 end;
8148
8149 function TKOLToolbar.MaxBtnImgWidth: Integer;
8150 var I: Integer;
8151 Bt: TKOLToolbarButton;
8152 begin
8153 asm
8154 jmp @@e_signature
8155 DB '#$signature$#', 0
8156 DB 'TKOLToolbar.MaxBtnImgWidth', 0
8157 @@e_signature:
8158 end;
8159 Result := 0;
8160 for I := 0 to Items.Count-1 do
8161 begin
8162 Bt := Items[ I ];
8163 if Bt.HasPicture and (Bt.picture.Width > Result) then
8164 Result := Bt.picture.Width;
8165 end;
8166 end;
8167
8168 function TKOLToolbar.NoMorePicturedButtonsFrom(Idx: Integer): Boolean;
8169 var I: Integer;
8170 Bt: TKOLToolbarButton;
8171 begin
8172 Result := TRUE;
8173 for I := Idx to Items.Count - 1 do
8174 begin
8175 Bt := Items[ I ];
8176 if Bt.HasPicture or (Bt.sysimg <> stiCustom) then
8177 begin
8178 Result := FALSE;
8179 break;
8180 end;
8181 end;
8182 end;
8183
8184 function TKOLToolbar.PicturedButtonsCount: Integer;
8185 var I: Integer;
8186 Bt: TKOLToolbarButton;
8187 begin
8188 Result := 0;
8189 for I := 0 to Items.Count-1 do
8190 begin
8191 Bt := Items[ I ];
8192 if Bt.HasPicture then
8193 Inc( Result );
8194 end;
8195 //Rpt( '%%%%%%%%% PicturedButtonsCount := ' + IntToStr( Result ) );
8196 end;
8197
8198 procedure TKOLToolbar.SaveButtonCount(W: TWriter);
8199 begin
8200 asm
8201 jmp @@e_signature
8202 DB '#$signature$#', 0
8203 DB 'TKOLToolbar.SaveButtonCount', 0
8204 @@e_signature:
8205 end;
8206 FButtonCount := FItems.Count;
8207 //ShowMessage( 'saved FButtonCount=' + IntToStr( FButtonCount ) );
8208 W.WriteInteger( FButtonCount );
8209 end;
8210
8211 procedure TKOLToolbar.Setbitmap(const Value: TBitmap);
8212 begin
8213 asm
8214 jmp @@e_signature
8215 DB '#$signature$#', 0
8216 DB 'TKOLToolbar.Setbitmap', 0
8217 @@e_signature:
8218 end;
8219 if Value <> nil then
8220 Fbitmap.Assign( Value )
8221 else
8222 begin
8223 Fbitmap.Width := 0;
8224 Fbitmap.Height := 0;
8225 end;
8226 if not (csLoading in ComponentState) then
8227 bitmap2ItemPictures( TRUE );
8228 if Assigned(FKOLCtrl) then
8229 RecreateWnd;
8230 Change;
8231 end;
8232
8233 procedure TKOLToolbar.SetBtnCount_Dummy(const Value: Integer);
8234 begin
8235 asm
8236 jmp @@e_signature
8237 DB '#$signature$#', 0
8238 DB 'TKOLToolbar.SetBtnCount_Dummy', 0
8239 @@e_signature:
8240 end;
8241 //FButtonCount := Value;
8242 end;
8243
8244 procedure TKOLToolbar.SetbuttonMaxWidth(const Value: Integer);
8245 begin
8246 FbuttonMaxWidth := Value;
8247 Change;
8248 end;
8249
8250 procedure TKOLToolbar.SetbuttonMinWidth(const Value: Integer);
8251 begin
8252 FbuttonMinWidth := Value;
8253 Change;
8254 end;
8255
8256 procedure TKOLToolbar.SetgenerateConstants(const Value: Boolean);
8257 begin
8258 FgenerateConstants := Value;
8259 if Value then
8260 FgenerateVariables := FALSE;
8261 Change;
8262 end;
8263
8264 procedure TKOLToolbar.SetmapBitmapColors(const Value: Boolean);
8265 begin
8266 asm
8267 jmp @@e_signature
8268 DB '#$signature$#', 0
8269 DB 'TKOLToolbar.SetmapBitmapColors', 0
8270 @@e_signature:
8271 end;
8272 if Value = FmapBitmapColors then Exit;
8273 FmapBitmapColors := Value;
8274 if Assigned(FKOLCtrl) then
8275 RecreateWnd;
8276 Change;
8277 end;
8278
8279 procedure TKOLToolbar.SetnoTextLabels(const Value: Boolean);
8280 begin
8281 asm
8282 jmp @@e_signature
8283 DB '#$signature$#', 0
8284 DB 'TKOLToolbar.SetnoTextLabels', 0
8285 @@e_signature:
8286 end;
8287 FnoTextLabels := Value;
8288 UpdateButtons;
8289 Change;
8290 end;
8291
8292 procedure TKOLToolbar.SetOptions(const Value: TToolbarOptions);
8293 begin
8294 asm
8295 jmp @@e_signature
8296 DB '#$signature$#', 0
8297 DB 'TKOLToolbar.SetOptions', 0
8298 @@e_signature:
8299 end;
8300 FOptions := Value;
8301 if Assigned(FKOLCtrl) then
8302 RecreateWnd;
8303 Change;
8304 end;
8305
8306 procedure TKOLToolbar.SetpopupMenu(const Value: TKOLPopupMenu);
8307 begin
8308 asm
8309 jmp @@e_signature
8310 DB '#$signature$#', 0
8311 DB 'TKOLToolbar.SetpopupMenu', 0
8312 @@e_signature:
8313 end;
8314 FpopupMenu := Value;
8315 Change;
8316 end;
8317
8318 procedure TKOLToolbar.SetshowTooltips(const Value: Boolean);
8319 begin
8320 asm
8321 jmp @@e_signature
8322 DB '#$signature$#', 0
8323 DB 'TKOLToolbar.SetshowTooltips', 0
8324 @@e_signature:
8325 end;
8326 FshowTooltips := Value;
8327 Change;
8328 end;
8329
8330 procedure TKOLToolbar.SetStandardImagesLarge(const Value: Boolean);
8331 begin
8332 FStandardImagesLarge := Value;
8333 if Assigned(FKOLCtrl) then
8334 RecreateWnd;
8335 Change;
8336 end;
8337
8338 procedure TKOLToolbar.Settooltips(const Value: TStrings);
8339 begin
8340 asm
8341 jmp @@e_signature
8342 DB '#$signature$#', 0
8343 DB 'TKOLToolbar.Settooltips', 0
8344 @@e_signature:
8345 end;
8346 Ftooltips.Text := Value.Text;
8347 Change;
8348 end;
8349
8350 procedure TKOLToolbar.SetupFirst(SL: TStringList; const AName, AParent,
8351 Prefix: String);
8352 var RsrcFile, RsrcName: String;
8353 S, B: String;
8354 I, J, K, W, H, N, I0: Integer;
8355 ResBmpID: Integer;
8356 Bmp: TBitmap;
8357 Bt, Bt1: TKOLToolbarButton;
8358 Btn1st: Integer;
8359 begin
8360 asm
8361 jmp @@e_signature
8362 DB '#$signature$#', 0
8363 DB 'TKOLToolbar.SetupFirst', 0
8364 @@e_signature:
8365 end;
8366 ResBmpID := -1;
8367 RsrcName := '';
8368 H := MaxBtnImgHeight;
8369 W := MaxBtnImgWidth;
8370 if W * H > 0 then
8371 begin
8372 ResBmpID := ParentKOLForm.NextUniqueID;
8373 RsrcName := UpperCase( ParentKOLForm.FormName ) + '_TBBMP' + IntToStr( ResBmpID );
8374 RsrcFile := ParentKOLForm.FormName + '_' + Name;
8375 SL.Add( Prefix + ' {$R ' + RsrcFile + '.res}' );
8376 Bmp := TBitmap.Create;
8377 TRY
8378 N := 0;
8379 FBmpTranColor := clNone;
8380 for I := 0 to Items.Count-1 do
8381 begin
8382 Bt := Items[ I ];
8383 if Bt.HasPicture then
8384 begin
8385 if FBmpTranColor = clNone then
8386 begin
8387 Bmp.Assign( Bt.picture );
8388 FBmpTranColor := Bmp.Canvas.Pixels[ 0, Bmp.Height - 1 ];
8389 end;
8390 Inc( N );
8391 end;
8392 end;
8393 Bmp.Width := N * W;
8394 Bmp.Height := H;
8395 {$IFNDEF _D2}
8396 Bmp.PixelFormat := pf24bit;
8397 {$ENDIF}
8398 if FBmpTranColor <> clNone then
8399 begin
8400 Bmp.Canvas.Brush.Color := FBmpTranColor;
8401 Bmp.Canvas.FillRect( Rect( 0, 0, Bmp.Width, Bmp.Height ) );
8402 end;
8403 N := 0;
8404 for I := 0 to Items.Count-1 do
8405 begin
8406 Bt := Items[ I ];
8407 if Bt.HasPicture then
8408 begin
8409 Bmp.Canvas.Draw( N * W, 0, Bt.picture.Graphic );
8410 Inc( N );
8411 end;
8412 end;
8413 GenerateBitmapResource( Bmp, RsrcName, RsrcFile, fUpdated );
8414 FINALLY
8415 Bmp.Free;
8416 END;
8417 end;
8418 if HeightAuto then
8419 begin
8420 DefaultHeight := Height;
8421 DefaultWidth := Width;
8422 end
8423 else
8424 begin
8425 if Align in [ caTop, caBottom, caNone ] then
8426 begin
8427 DefaultHeight := 22;
8428 DefaultWidth := Width;
8429 end
8430 else
8431 if Align in [ caLeft, caRight ] then
8432 begin
8433 DefaultHeight := Height;
8434 DefaultWidth := 44;
8435 end
8436 else
8437 begin
8438 DefaultHeight := Height;
8439 DefaultWidth := Width;
8440 end;
8441 end;
8442 inherited;
8443 FResBmpID := ResBmpID;
8444 if Assigned( bitmap ) and (bitmap.Width * bitmap.Height > 0) then
8445 begin
8446 W := MaxBtnImgWidth;
8447 H := MaxBtnImgHeight;
8448 if (W <> H) or (StandardImagesUsed > 0) then
8449 begin
8450 SL.Add( ' ' + Prefix + AName + '.TBBtnImgWidth := ' + IntToStr( W ) + ';' );
8451 S := ' ' + Prefix + AName + '.TBAddBitmap( ';
8452 if mapBitmapColors then
8453 S := S + 'LoadMappedBitmapEx( ' + AName + ', hInstance, ''' + RsrcName + ''', [ ' +
8454 Color2Str( FBmpTranColor ) + ', Color2RGB( clBtnFace ) ] ) );'
8455 else
8456 S := S + 'LoadBmp( hInstance, ''' + RsrcName + ''', ' +
8457 AName + ' ) );';
8458 SL.Add( S );
8459 end;
8460 end;
8461 if TBButtonsWidth > 0 then
8462 SL.Add( ' ' + Prefix + AName + '.Perform( TB_SETBUTTONSIZE, ' +
8463 Int2Str( TBButtonsWidth ) + ', 0 );' );
8464 if ((StandardImagesUsed > 0) and (PicturedButtonsCount > 0)) or
8465 not IntIn(StandardImagesUsed, [ 1, 2, 4 ]) then
8466 begin
8467 if LongBool( StandardImagesUsed and 1 ) then
8468 begin
8469 if StandardImagesLarge then
8470 S := '-2'
8471 else
8472 S := '-1';
8473 SL.Add( ' ' + Prefix + AName + '.TBAddBitmap( THandle( ' + S + ' ) );' );
8474 end;
8475 if LongBool( StandardImagesUsed and 2 ) then
8476 begin
8477 if StandardImagesLarge then
8478 S := '-6'
8479 else
8480 S := '-5';
8481 SL.Add( ' ' + Prefix + AName + '.TBAddBitmap( THandle( ' + S + ' ) );' );
8482 end;
8483 if LongBool( StandardImagesUsed and 4 ) then
8484 begin
8485 if StandardImagesLarge then
8486 S := '-10'
8487 else
8488 S := '-9';
8489 SL.Add( ' ' + Prefix + AName + '.TBAddBitmap( THandle( ' + S + ' ) );' );
8490 end;
8491 end;
8492
8493 if showTooltips or (tooltips.Count > 0) then
8494 begin
8495 S := '';
8496 J := 0;
8497 for I := 0 to Items.Count-1 do
8498 begin
8499 Bt := Items[ I ];
8500 //if Bt.Faction <> nil then continue; // remove by YS 7-Aug-2004
8501 //if Bt.separator then continue;
8502
8503 //---------{ Maxim Pushkar }----------------------------------------------
8504 //if (tooltips.Count > 0) and (J > tooltips.Count) then break;
8505 //----------------------------------------------------------------------//
8506 if (tooltips.Count > 0) and (J >= tooltips.Count) then break; //
8507 //--------------------------------------------------------------------//
8508
8509 if Bt.Tooltip <> '' then
8510 B := Bt.Tooltip
8511 else
8512 if (tooltips.Count > 0) and (tooltips[ J ] <> '') and not Bt.separator then
8513 B := tooltips[ J ]
8514 else
8515 if showTooltips then
8516 B := Bt.Caption
8517 else
8518 B := '';
8519 if Bt.Faction = nil then // {YS} äîáàâèòü
8520 begin // {YS} äîáàâèòü
8521 if not Bt.separator then // {YS} äîáàâèòü
8522 begin
8523 if S <> '' then
8524 S := S + ', ';
8525 S := S + PCharStringConstant( Self, Bt.Name + '_tip', B );
8526 end
8527 else
8528 //+++++++ v1.94
8529 begin
8530 if S <> '' then
8531 S := S + ', '''''
8532 else
8533 S := S + '''''';
8534 end;
8535 //------
8536 end // {YS} äîáàâèòü
8537 else // {YS} äîáàâèòü
8538 Inc( J );
8539 end;
8540 // change by Alexander Pravdin (to fix tooltips for case of first separator):
8541 //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
8542 Btn1st := 0;
8543 {for i := 0 to ButtonCount - 1 do
8544 if not TKOLToolbarButton( FItems.Items[i] ).Fseparator then begin
8545 Btn1st := i;
8546 Break;
8547 end;}
8548 if S <> '' then
8549 SL.Add( Prefix + ' ' + AName + '.TBSetTooltips( ' + AName +
8550 '.TBIndex2Item( ' + IntToStr( Btn1st ) + ' ), [ ' + S + ' ] );' );
8551 //--------------------------------------------------------------------------
8552 {if S <> '' then
8553 SL.Add( Prefix + ' ' + AName + '.TBSetTooltips( ' + AName +
8554 '.TBIndex2Item( 0 ), [ ' + S + ' ] );' );}
8555 ////////////////////////////////////////////////////////////////////////////
8556 end;
8557
8558 // assign image list if used:
8559 if ImageListNormal <> nil then
8560 begin
8561 SL.Add( Prefix + ' ' + AName + '.Perform( TB_SETIMAGELIST, 0, Result.' +
8562 ImageListNormal.Name + '.Handle );' );
8563 end;
8564 if ImageListDisabled <> nil then
8565 begin
8566 SL.Add( Prefix + ' ' + AName + '.Perform( TB_SETDISABLEDIMAGELIST, 0, Result.' +
8567 ImageListDisabled.Name + '.Handle );' );
8568 end;
8569 if ImageListHot <> nil then
8570 begin
8571 SL.Add( Prefix + ' ' + AName + '.Perform( TB_SETHOTIMAGELIST, 0, Result.' +
8572 ImageListHot.Name + '.Handle );' );
8573 end;
8574
8575 I0 := -1;
8576 for I := 0 to Items.Count-1 do
8577 begin
8578 Bt := Items[ I ];
8579 Inc( I0 );
8580 //if Bt.separator then Continue;
8581 if Bt.fOnClickMethodName <> '' then
8582 begin
8583 S := '';
8584 for J := I to Items.Count - 1 do
8585 begin
8586 Bt := Items[ J ];
8587 //if Bt.separator then Continue;
8588 if Bt.separator or (Bt.fOnClickMethodName = '') then
8589 begin
8590 N := 0;
8591 for K := J to Items.Count-1 do
8592 begin
8593 Bt1 := Items[ K ];
8594 if Bt1.separator then Continue;
8595 if Bt1.fOnClickMethodName <> '' then
8596 begin
8597 Inc( N );
8598 break;
8599 end;
8600 end;
8601 if N = 0 then break;
8602 end;
8603 if S <> '' then S := S + ', ';
8604 if Bt.fOnClickMethodName <> '' then
8605 S := S + 'Result.' + Bt.fOnClickMethodName
8606 else
8607 S := S + 'nil';
8608 end;
8609 SL.Add( ' ' + Prefix + AName + '.TBAssignEvents( ' + IntToStr( I0 ) +
8610 ', [ ' + S + ' ] );' );
8611 break;
8612 end;
8613 end;
8614 if Assigned( FpopupMenu ) then
8615 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
8616 ' );' );
8617 if TBButtonsMinWidth > 0 then
8618 SL.Add( Prefix + AName + '.TBButtonsMinWidth := ' + IntToStr( TBButtonsMinWidth ) + ';' );
8619 if TBButtonsMaxWidth > 0 then
8620 SL.Add( Prefix + AName + '.TBButtonsMaxWidth := ' + IntToStr( TBButtonsMaxWidth ) + ';' );
8621 for I := Items.Count-1 downto 0 do
8622 begin
8623 Bt := Items[ I ];
8624 if not Bt.visible and (Bt.Faction = nil) then
8625 SL.Add( Prefix + AName + '.TBButtonVisible[ ' + IntToStr( I ) + ' ] := FALSE;' );
8626 {if Bt.Checked and (Bt.Faction = nil) then
8627 SL.Add( Prefix + AName + '.TBButtonChecked[ ' + IntToStr( I ) + ' ] := TRUE;' );}
8628 if not Bt.enabled and (Bt.Faction = nil) then
8629 SL.Add( Prefix + AName + '.TBButtonEnabled[ ' + IntToStr( I ) + ' ] := FALSE;' );
8630 end;
8631
8632 if FixFlatXP then
8633 if (tboFlat in Options) and (Parent <> nil) and not(Parent is TForm) then
8634 begin
8635 if Align in [ caLeft, caRight ] then
8636 begin
8637 SL.Add( Prefix + ' ' + AName + '.Style := ' + AName +
8638 '.Style or TBSTYLE_WRAPABLE;' );
8639 end
8640 else
8641 begin
8642 SL.Add( Prefix + 'if WinVer >= wvXP then' );
8643 SL.Add( Prefix + 'begin' );
8644 SL.Add( Prefix + ' ' + AName + '.Style := ' + AName +
8645 '.Style or TBSTYLE_WRAPABLE;' );
8646 SL.Add( Prefix + ' ' + AName + '.Transparent := TRUE;' );
8647 SL.Add( Prefix + 'end;' );
8648 end;
8649 end;
8650 end;
8651
8652 function TKOLToolbar.SetupParams(const AName, AParent: String): String;
8653 var S, A: String;
8654 B: String;
8655 I, N: Integer;
8656 Bt, Bt1: TKOLToolbarButton;
8657 StdImagesStart, ViewImagesStart, HistImagesStart: Integer;
8658 TheSameBefore, TheSameAfter: Boolean;
8659 begin
8660 asm
8661 jmp @@e_signature
8662 DB '#$signature$#', 0
8663 DB 'TKOLToolbar.SetupParams', 0
8664 @@e_signature:
8665 end;
8666 // 1. Options parameter
8667 S := '';
8668 if (tboTextRight in Options) or
8669 FixFlatXP and {(Align in [caLeft, caRight]) and} (tboFlat in Options) then
8670 S := 'tboTextRight';
8671 if (tboTextBottom in Options) and (S = '') then
8672 S := S + ', tboTextBottom';
8673 if tboFlat in Options then
8674 S := S + ', tboFlat';
8675 if tboTransparent in Options then
8676 S := S + ', tboTransparent';
8677 if (tboWrapable in Options) and not( FixFlatXP and (Align in [caLeft, caRight]) and
8678 (tboFlat in Options) )
8679 {or
8680 ( (tboFlat in Options) and not (Align in [caLeft, caRight] ) and FixFlatXP )} then
8681 S := S + ', tboWrapable';
8682 if tboNoDivider in Options then
8683 S := S + ', tboNoDivider';
8684 if tbo3DBorder in Options then
8685 S := S + ', tbo3DBorder';
8686 if S <> '' then
8687 if S[ 1 ] = ',' then
8688 S := Trim( Copy( S, 2, MaxInt ) );
8689
8690 // 2. Align parameter
8691 case Align of
8692 caLeft: A := 'caLeft';
8693 caRight:A := 'caRight';
8694 caClient: A := 'caClient';
8695 caTop: A := 'caTop';
8696 caBottom: A := 'caBottom';
8697 else A := 'caNone';
8698 end;
8699 Result := AParent + ', ' + A + ', [' + S + '], ';
8700
8701 // 3. Bitmap from a resource
8702 if (Bitmap.Width > 0) and (Bitmap.Height > 0) and
8703 (FResBmpID >= 0) and (MaxBtnImgWidth = MaxBtnImgHeight) and
8704 (StandardImagesUsed=0) then
8705 begin
8706 if mapBitmapColors then
8707 Result := Result + 'LoadMappedBitmapEx( Result, hInstance, ''' +
8708 UpperCase( ParentKOLForm.FormName ) + '_TBBMP' + IntToStr( FResBmpID ) + ''', [ ' +
8709 Color2Str( FBmpTranColor ) + ', Color2RGB( clBtnFace ) ] ), '
8710 else
8711 Result := Result + 'LoadBmp( hInstance, PChar( ''' +
8712 UpperCase( ParentKOLForm.FormName ) + '_TBBMP' + IntToStr( FResBmpID ) +
8713 ''' ), Result ), ';
8714 end
8715 else // or if standard images are used, type of images here
8716 if (PicturedButtonsCount = 0) and (IntIn( StandardImagesUsed, [ 1, 2, 4 ] )) then
8717 begin
8718 if StandardImagesUsed = 1 then
8719 if StandardImagesLarge then
8720 Result := Result + 'THandle( -2 ), '
8721 else
8722 Result := Result + 'THandle( -1 ), '
8723 else
8724 if StandardImagesUsed = 2 then
8725 if StandardImagesLarge then
8726 Result := Result + 'THandle( -6 ), '
8727 else
8728 Result := Result + 'THandle( -5 ), '
8729 else
8730 if StandardImagesLarge then
8731 Result := Result + 'THandle( -10 ), '
8732 else
8733 Result := Result + 'THandle( -9 ), ';
8734 end
8735 else
8736 begin // or if Bitmap is empty, value 0
8737 if not ((Bitmap.Width > 0) and (Bitmap.Height > 0) and
8738 (FResBmpID >= 0)) then
8739 FResBmpID := 0;
8740 Result := Result + '0, ';
8741 end;
8742
8743 // 4. Button captions
8744 Result := Result + '[ ';
8745
8746 for I := 0 to Items.Count-1 do
8747 begin
8748 Bt := Items[ I ];
8749 if Bt.separator then
8750 Result := Result + '''-'''
8751 else
8752 begin
8753 if noTextLabels then
8754 B := ' '
8755 else
8756 B := Bt.Fcaption;
8757 S := '';
8758 if Bt.radioGroup <> 0 then
8759 begin
8760 TheSameBefore := FALSE;
8761 TheSameAfter := FALSE;
8762 if I > 0 then
8763 begin
8764 Bt1 := Items[ I - 1 ];
8765 if not Bt1.separator and (Bt1.FradioGroup = Bt.FradioGroup) then
8766 TheSameBefore := TRUE;
8767 end;
8768 if I < Items.Count-1 then
8769 begin
8770 Bt1 := Items[ I + 1 ];
8771 if not Bt1.separator and (Bt1.FradioGroup = Bt.FradioGroup) then
8772 TheSameAfter := TRUE;
8773 end;
8774 if TheSameBefore or TheSameAfter then
8775 S := '!' + S;
8776 end;
8777 if Bt.checked and (Bt.Faction = nil) then
8778 S := '+' + S
8779 else
8780 if Bt.radioGroup <> 0 then
8781 S := '-' + S;
8782 if Bt.dropdown then
8783 S := '^' + S;
8784 if noTextLabels then
8785 Result := Result + '''' + S + B + ''''
8786 else
8787 if Bt.Faction <> nil then
8788 Result := Result + '''' + S + ' '''
8789 else
8790 begin
8791 B := StringConstant( Bt.Name + '_btn', B );
8792 if (B <> '') and (B[ 1 ] = '''') then
8793 Result := Result + '''' + S + Copy( B, 2, MaxInt )
8794 else
8795 if S <> '' then
8796 Result := Result + 'PChar( ''' + S + ''' + ' + B + ')'
8797 else
8798 Result := Result + 'PChar( ' + B + ' )';
8799 end;
8800 end;
8801 if I < Items.Count-1 then
8802 Result := Result + ', ';
8803 end;
8804 Result := Result + ' ], ';
8805
8806 // 5. Button image indexes used
8807 //Rpt( '$$$$$$$$$$$$$$$ PicturedButtonsCount := ' + IntToStr( PicturedButtonsCount ) );
8808 if (StandardImagesUsed = 0) and (PicturedButtonsCount = 0) and not ImageListsUsed then
8809 Result := Result + '[ -2 ]' else
8810 if (StandardImagesUsed = 0) and AllPicturedButtonsAreLeading and
8811 LastBtnHasPicture and not ImageListsUsed then
8812 Result := Result + '[ 0 ]' else
8813 begin
8814 N := PicturedButtonsCount;
8815 Result := Result + '[ ';
8816 StdImagesStart := N;
8817 ViewImagesStart := N;
8818 HistImagesStart := N;
8819 if (StandardImagesUsed > 1) and LongBool(StandardImagesUsed and 1) then
8820 begin
8821 ViewImagesStart := N + 15;
8822 HistImagesStart := N + 15;
8823 end;
8824 if LongBool(StandardImagesUsed and 2) then
8825 HistImagesStart := HistImagesStart + 12;
8826 N := 0;
8827 S := '';
8828 for I := 0 to Items.Count-1 do
8829 begin
8830 Bt := Items[ I ];
8831 //Rpt( '%%%%%%%%%% Bt ' + Bt.Name + ' HasPicture := ' + IntToStr( Integer( Bt.HasPicture ) ) );
8832 if ImageListsUsed then
8833 begin
8834 if Bt.imgIndex >= 0 then
8835 S := IntToStr( Bt.imgIndex )
8836 else
8837 S := '-2';
8838 end
8839 else
8840 if Bt.HasPicture then
8841 begin
8842 S := IntToStr( N );
8843 Inc( N );
8844 end
8845 else
8846 case Bt.sysimg of
8847 stiCustom:
8848 S := '-2'; // I_IMAGENONE
8849 stdCUT..stdPRINT:
8850 S := IntToStr( StdImagesStart + Ord( Bt.sysimg ) - Ord( stdCUT ) );
8851 viewLARGEICONS..viewVIEWMENU:
8852 S := IntToStr( ViewImagesStart + Ord( Bt.sysimg ) - Ord( viewLARGEICONS ) );
8853 else
8854 S := IntToStr( HistImagesStart + Ord( Bt.sysimg ) - Ord( histBACK ) );
8855 end;
8856 Result := Result + S + ', ';
8857 end;
8858 if Items.Count > 0 then
8859 Result := Copy( Result, 1, Length( Result ) - 2 ) + ' ]'
8860 else
8861 Result := Result + ']';
8862 end;
8863 end;
8864
8865 var LastToolbarWarningtime: Integer;
8866 procedure ToolbarBetterToPlaceOverPanelWarning;
8867 begin
8868 asm
8869 jmp @@e_signature
8870 DB '#$signature$#', 0
8871 DB 'ToolbarBetterToPlaceOverPanelWarning', 0
8872 @@e_signature:
8873 end;
8874 if Abs( Integer( GetTickCount ) - LastToolbarWarningtime ) > 60000 then
8875 begin
8876 LastToolbarWarningtime := GetTickCount;
8877 {ShowMessage( 'It is better to place toolbar on a panel aligning it caClient.'#13 +
8878 'This can improve performance of the application, especially in ' +
8879 'Windows 9x/Me.' );}
8880 end;
8881 end;
8882
8883 function TKOLToolbar.StandardImagesUsed: Integer;
8884 var I: Integer;
8885 Bt: TKOLToolbarButton;
8886 begin
8887 Result := 0;
8888 for I := 0 to Items.Count-1 do
8889 begin
8890 Bt := Items[ I ];
8891 if Bt.sysimg <> stiCustom then
8892 begin
8893 if Bt.sysimg in [ stdCUT..stdPRINT ] then
8894 Result := Result or 1
8895 else
8896 if Bt.sysimg in [ viewLARGEICONS..viewVIEWMENU ] then
8897 Result := Result or 2
8898 else
8899 Result := Result or 4;
8900 if Result = 7 then break;
8901 end;
8902 end;
8903 end;
8904
8905 procedure TKOLToolbar.Tick(Sender: TObject);
8906 var KF: TKOLForm;
8907 begin
8908 asm
8909 jmp @@e_signature
8910 DB '#$signature$#', 0
8911 DB 'TKOLToolbar.Tick', 0
8912 @@e_signature:
8913 end;
8914 if Parent <> nil then
8915 begin
8916 FTimer.Enabled := FALSE;
8917 if Parent = Owner then
8918 ToolbarBetterToPlaceOverPanelWarning;
8919 //ParentKOLForm.AlignChildren( nil );
8920 if Parent is TKOLCustomControl then
8921 (Parent as TKOLCustomControl).ReAlign( FALSE )
8922 else
8923 begin
8924 KF := ParentKOLForm;
8925 if KF <> nil then
8926 KF.AlignChildren( nil, FALSE );
8927 end;
8928 FTimer.Free;
8929 FTimer := nil;
8930 end;
8931 end;
8932
8933 procedure TKOLToolbar.ReadNewVersion(Reader: TReader);
8934 begin
8935 fNewVersion := Reader.ReadBoolean;
8936 end;
8937
8938 procedure TKOLToolbar.WriteNewVersion(Writer: TWriter);
8939 begin
8940 Writer.WriteBoolean( fNewVersion );
8941 end;
8942
8943 function TKOLToolbar.Generate_SetSize: String;
8944 begin
8945 Result := inherited Generate_SetSize;
8946 end;
8947
8948 procedure TKOLToolbar.SetAutoHeight(const Value: Boolean);
8949 begin
8950 FHeightAuto := Value;
8951 Change;
8952 end;
8953
8954 procedure TKOLToolbar.CreateKOLControl(Recreating: boolean);
8955 var
8956 al: kol.TControlAlign;
8957 bmp: HBITMAP;
8958 begin
8959 if Recreating then begin
8960 al:=kol.TControlAlign(Align);
8961 //bmp:=bitmap.Handle;
8962 bmp := 0;
8963 end
8964 else begin
8965 al:=kol.caTop;
8966 bmp:=0;
8967 end;
8968 TRY
8969 FKOLCtrl:=NewToolbar(KOLParentCtrl, al, kol.TToolbarOptions(FOptions), bmp, [nil], [-2]);
8970 FKOLCtrl.Visible:=False;
8971 EXCEPT
8972 on E: Exception do
8973 begin
8974 ShowMessage( 'Error: ' + E.Message );
8975 end;
8976 END;
8977 end;
8978
8979 procedure TKOLToolbar.KOLControlRecreated;
8980 var
8981 N: integer;
8982 TmpBmp, TmpBmp2: TBitmap;
8983 begin
8984 inherited;
8985 if ImageListsUsed then
8986 begin
8987 if ImageListNormal <> nil then
8988 FKOLCtrl.Perform( TB_SETIMAGELIST, 0, ImageListNormal.Handle );
8989 if ImageListDisabled <> nil then
8990 FKOLCtrl.Perform( TB_SETDISABLEDIMAGELIST, 0, ImageListDisabled.Handle );
8991 if ImageListHot <> nil then
8992 FKOLCtrl.Perform( TB_SETHOTIMAGELIST, 0, ImageListHot.Handle );
8993 end
8994 else
8995 begin
8996 if StandardImagesUsed > 0 then begin
8997 if StandardImagesLarge then
8998 N:=1
8999 else
9000 N:=0;
9001 FKOLCtrl.TBAddBitmap(HBITMAP(-1-N));
9002 FKOLCtrl.TBAddBitmap(HBITMAP(-5-N));
9003 FKOLCtrl.TBAddBitmap(HBITMAP(-9-N));
9004 end;
9005 if (Bitmap <> nil) and not Bitmap.Empty then
9006 begin
9007 if mapBitmapColors then
9008 begin
9009 TmpBmp := TBitmap.Create;
9010 TRY
9011 TmpBmp.Canvas.Brush.Color := clBtnFace;
9012 TmpBmp.Width := Bitmap.Width;
9013 TmpBmp.Height := Bitmap.Height;
9014 {$IFDEF _D3orHigher}
9015 Bitmap.Transparent := TRUE;
9016 {$ENDIF}
9017 //Bitmap.TransparentColor := Bitmap.Canvas.Pixels[ 0, Bitmap.Height-1 ];
9018 TmpBmp.Canvas.Draw( 0, 0, Bitmap );
9019 {$IFDEF _D3orHigher}
9020 Bitmap.Transparent := FALSE;
9021 {$ENDIF}
9022 FBmpDesign := //CopyImage( TmpBmp.Handle, IMAGE_BITMAP, 0, 0, 0 {LR_CREATEDIBSECTION} );
9023 TmpBmp.ReleaseHandle;
9024 FINALLY
9025 TmpBmp.Free;
9026 END;
9027 end
9028 else
9029 begin
9030 FBmpDesign := CopyImage( Bitmap.Handle, IMAGE_BITMAP, 0, 0, LR_CREATEDIBSECTION );
9031 end;
9032
9033 if mapBitmapColors then
9034 begin
9035 TmpBmp := TBitmap.Create;
9036 TmpBmp2 := TBitmap.Create;
9037 TRY
9038 TmpBmp.Handle := FBmpDesign;
9039 TmpBmp2.Canvas.Brush.Color := clBtnFace;
9040 TmpBmp2.Width := TmpBmp.Width;
9041 TmpBmp2.Height := TmpBmp.Height;
9042 {$IFDEF _D3orHigher}
9043 TmpBmp.Transparent := TRUE;
9044 {$ENDIF}
9045 TmpBmp2.Canvas.Draw( 0, 0, TmpBmp );
9046 FBmpDesign := TmpBmp2.ReleaseHandle;
9047 FINALLY
9048 TmpBmp.Free;
9049 TmpBmp2.Free;
9050 END;
9051 end;
9052 FKOLCtrl.TBAddBitmap( FBmpDesign );
9053 end;
9054 end;
9055 UpdateButtons;
9056 ReAlign(True);
9057 end;
9058
9059 function TKOLToolbar.NoDrawFrame: Boolean;
9060 begin
9061 Result:=HasBorder;
9062 end;
9063
9064 procedure TKOLToolbar.UpdateButtons;
9065
9066 procedure GenerateButtons{(var Captions: array of string; var PCaptions: array of PChar; var ImgIndices: array of integer)};
9067 var
9068 i, N, StdImagesStart, ViewImagesStart, HistImagesStart: integer;
9069 s: string;
9070 ii: Integer;
9071 Bt: TKOLToolbarButton;
9072 begin
9073 if FItems.Count = 0 then exit;
9074 {if PicturedButtonsCount > 0 then
9075 N := FItems.Count
9076 else
9077 N:=0;}
9078 StdImagesStart := 0;
9079 ViewImagesStart := 15;
9080 HistImagesStart := 15 + 12;
9081 N := 0;
9082 if StandardImagesUsed > 0 then
9083 N := 15 + 12 + 5;
9084 for i:=0 to FItems.Count - 1 do
9085 with TKOLToolbarButton(FItems[i]) do begin
9086 if noTextLabels then
9087 s:=' '
9088 else
9089 s:=caption;
9090 if checked then
9091 S := '+' + S
9092 else
9093 if radioGroup <> 0 then
9094 S := '-' + S;
9095 if dropdown then
9096 S := '^' + S;
9097 {Captions[i]:=s;
9098 PCaptions[i]:=PChar(Captions[i]);}
9099 Bt := Items[ i ];
9100 if ImageListsUsed then
9101 begin
9102 ii := Bt.imgIndex;
9103 if ii < 0 then ii := -2;
9104 end
9105 else
9106 if HasPicture then begin
9107 ii {ImgIndices[i]} := N + i;
9108 end
9109 else
9110 case sysimg of
9111 stiCustom:
9112 ii {ImgIndices[i]} := -2; // I_IMAGENONE
9113 stdCUT..stdPRINT:
9114 ii {ImgIndices[i]} := StdImagesStart + Ord( sysimg ) - Ord( stdCUT );
9115 viewLARGEICONS..viewVIEWMENU:
9116 ii {ImgIndices[i]} := ViewImagesStart + Ord( sysimg ) - Ord( viewLARGEICONS );
9117 else
9118 ii {ImgIndices[i]} := HistImagesStart + Ord( sysimg ) - Ord( histBACK );
9119 end;
9120 FKOLCtrl.TBAddButtons( [ PChar( S ) ], [ ii ] );
9121 end;
9122 end;
9123
9124 var
9125 {capts: array of string;
9126 pcapts: array of PChar;
9127 imgs: array of integer;}
9128 i: integer;
9129
9130 begin
9131 if not Assigned(FKOLCtrl) then exit;
9132 while FKOLCtrl.TBButtonCount > 0 do
9133 FKOLCtrl.TBDeleteButton(0);
9134
9135 if FItems.Count > 0 then begin
9136 {SetLength(capts, FItems.Count);
9137 SetLength(pcapts, FItems.Count);
9138 SetLength(imgs, FItems.Count);}
9139 GenerateButtons{(capts, pcapts, imgs)};
9140 //FKOLCtrl.TBAddButtons(pcapts, imgs);
9141 for i:=0 to FItems.Count - 1 do
9142 with TKOLToolbarButton(FItems[i]) do begin
9143 if not enabled then
9144 FKOLCtrl.TBButtonEnabled[i]:=False;
9145 end;
9146 end;
9147 end;
9148
9149 procedure TKOLToolbar.SetMargin(const Value: Integer);
9150 begin
9151 inherited;
9152 if Assigned(FKOLCtrl) then
9153 FKOLCtrl.Perform( TB_SETINDENT, Border, 0 );
9154 end;
9155
9156 procedure TKOLToolbar.CMDesignHitTest(var Message: TCMDesignHitTest);
9157 var
9158 pt: TPoint;
9159 res: integer;
9160 begin
9161 if Assigned(FKOLCtrl) and (PaintType in [ptWYSIWIG, ptWYSIWIGFrames]) then begin
9162 Message.Result:=0;
9163 pt:=SmallPointToPoint(Message.Pos);
9164 res:=FKOLCtrl.Perform(WM_USER + 69 {TB_HITTEST}, 0, integer(@pt));
9165 if Abs(res) <= FKOLCtrl.TBButtonCount then
9166 Message.Result:=1;
9167 end
9168 else
9169 inherited;
9170 end;
9171
9172 procedure TKOLToolbar.WMLButtonDown(var Message: TWMLButtonDown);
9173 var
9174 pt: TPoint;
9175 res: integer;
9176 F: TForm;
9177 D: IDesigner;
9178 FD: IFormDesigner;
9179 begin
9180 if Assigned(FKOLCtrl) then begin
9181 pt:=SmallPointToPoint(Message.Pos);
9182 res:=FKOLCtrl.Perform(WM_USER + 69 {TB_HITTEST}, 0, integer(@pt));
9183 if res < 0 then
9184 res:=-res - 1;
9185 if res < FItems.Count then begin
9186 F := Owner as TForm;
9187 if F <> nil then begin
9188 //*///////////////////////////////////////////////////////
9189 {$IFDEF _D6orHigher} //
9190 F.Designer.QueryInterface(IFormDesigner,D); //
9191 {$ELSE} //
9192 //*///////////////////////////////////////////////////////
9193 D := F.Designer;
9194 //*///////////////////////////////////////////////////////
9195 {$ENDIF} //
9196 //*///////////////////////////////////////////////////////
9197 if (D <> nil) and QueryFormDesigner( D, FD ) then begin
9198 FD.SelectComponent( FItems[res] );
9199 end;
9200 end;
9201 end;
9202 end
9203 else
9204 inherited;
9205 end;
9206
9207 procedure TKOLToolbar.WMMouseMove(var Message: TWMMouseMove);
9208 begin
9209 end;
9210
9211 procedure TKOLToolbar.WMLButtonDblClk(var Message: TWMLButtonDblClk);
9212 begin
9213 end;
9214
9215 procedure TKOLToolbar.Paint;
9216 var
9217 i: integer;
9218 R: TRect;
9219 begin
9220 inherited;
9221 if Assigned(FKOLCtrl) and (PaintType in [ptWYSIWIG, ptWYSIWIGFrames]) then
9222 with Canvas do begin
9223 Brush.Style:=bsClear;
9224 Pen.Color:=clBtnShadow;
9225 Pen.Style:=psDot;
9226 for i:=0 to FItems.Count - 1 do
9227 with TKOLToolbarButton(FItems[i]) do begin
9228 if checked or (not separator and not (tboFlat in Options)) then continue;
9229 FKOLCtrl.Perform( TB_GETITEMRECT, i, Integer( @R ) );
9230 if separator then
9231 Windows.Rectangle( Handle, R.Left, R.Top, R.Right, R.Bottom )
9232 else
9233 DrawEdge(Handle, R, BDR_RAISEDINNER, BF_RECT);
9234 end;
9235 Pen.Style:=psSolid;
9236 Brush.Style:=bsSolid;
9237 end;
9238 end;
9239
9240 function TKOLToolbar.GetDefaultControlFont: HFONT;
9241 begin
9242 Result:=GetStockObject(DEFAULT_GUI_FONT);
9243 end;
9244
9245 procedure TKOLToolbar.SetimageList(const Value: TKOLImageList);
9246 procedure RemoveOldImageList;
9247 begin
9248 if FImageListNormal <> nil then
9249 FImageListNormal.NotifyLinkedComponent( Self, noRemoved );
9250 FImageListNormal := nil;
9251 end;
9252
9253 var I: Integer;
9254 Bt: TKOLToolbarButton;
9255 begin
9256 if (Value <> nil) and (Value is TKOLImageList) then
9257 begin
9258 if ImagedButtonsCount > 0 then
9259 begin
9260 I := MessageBox( Application.Handle, 'Some buttons have pictures assigned.'#13#10 +
9261 'All pictures will be removed. Continue assigning image list to a toolbar?',
9262 PChar( Application.Title + ' : ' + Name ), MB_OKCANCEL );
9263 if I <> ID_OK then Exit;
9264 for I := 0 to Items.Count-1 do
9265 begin
9266 Bt := Items[ I ];
9267 if Bt.HasPicture then
9268 Bt.picture := nil
9269 else
9270 if Bt.sysimg <> stiCustom then
9271 Bt.sysimg := stiCustom;
9272 if Bt.Fseparator then
9273 Bt.FimgIndex := -1;
9274 end;
9275 end;
9276 RemoveOldImageList;
9277 Value.AddToNotifyList( Self );
9278 end
9279 else
9280 RemoveOldImageList;
9281 FImageListNormal := Value;
9282 if Value <> nil then
9283 if FKOLCtrl <> nil then
9284 begin
9285 //ShowMessage( 'ImageListNormal.Handle=' + Int2Str( Value.Handle ) );
9286 FKOLCtrl.Perform( TB_SETIMAGELIST, 0, FImageListNormal.Handle );
9287 UpdateButtons;
9288 end;
9289 Change;
9290 end;
9291
9292 procedure TKOLToolbar.NotifyLinkedComponent(Sender: TObject;
9293 Operation: TNotifyOperation);
9294 begin
9295 asm
9296 jmp @@e_signature
9297 DB '#$signature$#', 0
9298 DB 'TKOLBitBtn.NotifyLinkedComponent', 0
9299 @@e_signature:
9300 end;
9301 inherited;
9302 if Operation = noRemoved then
9303 begin
9304 if Sender = ImageListNormal then
9305 ImageListNormal := nil
9306 else
9307 if Sender = ImageListDisabled then
9308 ImageListDisabled := nil
9309 else
9310 if Sender = ImageListHot then
9311 ImageListHot := nil
9312 else
9313 ShowMessage( 'Could not remove a reference to image list !' );
9314 end;
9315 end;
9316
9317 function TKOLToolbar.ImagedButtonsCount: Integer;
9318 var I: Integer;
9319 Bt: TKOLToolbarButton;
9320 begin
9321 Result := 0;
9322 for I := 0 to Items.Count-1 do
9323 begin
9324 Bt := Items[ I ];
9325 if Bt.HasPicture or (Bt.sysimg <> stiCustom) then
9326 Inc( Result );
9327 end;
9328 end;
9329
9330 function TKOLToolbar.MaxImgIndex: Integer;
9331 var I: Integer;
9332 Bt: TKOLToolbarButton;
9333 begin
9334 Result := 0;
9335 for I := 0 to Items.Count-1 do
9336 begin
9337 Bt := Items[ I ];
9338 if Bt.FimgIndex >= Result then
9339 Result := Bt.FimgIndex + 1;
9340 end;
9341 end;
9342
9343 procedure TKOLToolbar.SetDisabledimageList(const Value: TKOLImageList);
9344 procedure RemoveOldImageList;
9345 begin
9346 if FimageListDisabled <> nil then
9347 FimageListDisabled.NotifyLinkedComponent( Self, noRemoved );
9348 FimageListDisabled := nil;
9349 end;
9350
9351 var I: Integer;
9352 Bt: TKOLToolbarButton;
9353 begin
9354 if (Value <> nil) and (Value is TKOLImageList) then
9355 begin
9356 if ImagedButtonsCount > 0 then
9357 begin
9358 I := MessageBox( Application.Handle, 'Some buttons have pictures assigned.'#13#10 +
9359 'All pictures will be removed. Continue assigning image list to a toolbar?',
9360 PChar( Application.Title + ' : ' + Name ), MB_OKCANCEL );
9361 if I <> ID_OK then Exit;
9362 for I := 0 to Items.Count-1 do
9363 begin
9364 Bt := Items[ I ];
9365 if Bt.HasPicture then
9366 Bt.picture := nil
9367 else
9368 if Bt.sysimg <> stiCustom then
9369 Bt.sysimg := stiCustom;
9370 if Bt.Fseparator then
9371 Bt.FimgIndex := -1;
9372 end;
9373 end;
9374 RemoveOldImageList;
9375 Value.AddToNotifyList( Self );
9376 end
9377 else
9378 RemoveOldImageList;
9379 FimageListDisabled := Value;
9380 if Value <> nil then
9381 if FKOLCtrl <> nil then
9382 begin
9383 FKOLCtrl.Perform( TB_SETDISABLEDIMAGELIST, 0, FimageListDisabled.Handle );
9384 UpdateButtons;
9385 end;
9386 Change;
9387 end;
9388
9389 procedure TKOLToolbar.SetHotimageList(const Value: TKOLImageList);
9390 procedure RemoveOldImageList;
9391 begin
9392 if FImageListHot <> nil then
9393 FImageListHot.NotifyLinkedComponent( Self, noRemoved );
9394 FImageListHot := nil;
9395 end;
9396
9397 var I: Integer;
9398 Bt: TKOLToolbarButton;
9399 begin
9400 if (Value <> nil) and (Value is TKOLImageList) then
9401 begin
9402 if ImagedButtonsCount > 0 then
9403 begin
9404 I := MessageBox( Application.Handle, 'Some buttons have pictures assigned.'#13#10 +
9405 'All pictures will be removed. Continue assigning image list to a toolbar?',
9406 PChar( Application.Title + ' : ' + Name ), MB_OKCANCEL );
9407 if I <> ID_OK then Exit;
9408 for I := 0 to Items.Count-1 do
9409 begin
9410 Bt := Items[ I ];
9411 if Bt.HasPicture then
9412 Bt.picture := nil
9413 else
9414 if Bt.sysimg <> stiCustom then
9415 Bt.sysimg := stiCustom;
9416 if Bt.Fseparator then
9417 Bt.FimgIndex := -1;
9418 end;
9419 end;
9420 RemoveOldImageList;
9421 Value.AddToNotifyList( Self );
9422 end
9423 else
9424 RemoveOldImageList;
9425 FImageListHot := Value;
9426 if Value <> nil then
9427 if FKOLCtrl <> nil then
9428 begin
9429 FKOLCtrl.Perform( TB_SETHOTIMAGELIST, 0, FimageListHot.Handle );
9430 UpdateButtons;
9431 end;
9432 Change;
9433 end;
9434
9435 function TKOLToolbar.ImageListsUsed: Boolean;
9436 begin
9437 Result := (ImageListNormal <> nil) or (ImageListDisabled <> nil) or
9438 (ImageListHot <> nil);
9439 end;
9440
9441 procedure TKOLToolbar.SetFixFlatXP(const Value: Boolean);
9442 begin
9443 FFixFlatXP := Value;
9444 Change;
9445 end;
9446
9447 procedure TKOLToolbar.SetTBButtonsWidth(const Value: Integer);
9448 begin
9449 FTBButtonsWidth := Value;
9450 Change;
9451 end;
9452
9453 procedure TKOLToolbar.SetgenerateVariables(const Value: Boolean);
9454 begin
9455 FgenerateVariables := Value;
9456 if Value then
9457 FgenerateConstants := FALSE;
9458 Change;
9459 end;
9460
9461 procedure TKOLToolbar.SetupLast(SL: TStringList; const AName, AParent,
9462 Prefix: String);
9463 var I: Integer;
9464 Bt: TKOLToolbarButton;
9465 S: String;
9466 begin
9467 inherited;
9468 if generateVariables then
9469 begin
9470 S := '';
9471 for I := 0 to Items.Count-1 do
9472 begin
9473 Bt := Items[ I ];
9474 if Bt.separator and (Copy( Bt.Name, 1, 2 ) = 'TB') and
9475 IsNumber( Copy( Bt.Name, 3, MaxInt ) ) then
9476 continue;
9477 if Bt.Name <> '' then
9478 begin
9479 S := S + ',' + Bt.Name;
9480 end;
9481 end;
9482 if ( S <> '' ) then
9483 begin
9484 Delete( S, 1, 1 );
9485 SL.Add( Prefix + AName + '.TBConvertIdxArray2ID( [' + S + '] );' );
9486 end;
9487 end;
9488 end;
9489
9490 { TKOLToolbarButtonsEditor }
9491
9492 procedure TKOLToolbarButtonsEditor.Edit;
9493 var Tb: TKOLToolbar;
9494 begin
9495 asm
9496 jmp @@e_signature
9497 DB '#$signature$#', 0
9498 DB 'TKOLToolbarButtonsEditor.Edit', 0
9499 @@e_signature:
9500 end;
9501 if GetComponent( 0 ) = nil then Exit;
9502 Tb := GetComponent( 0 ) as TKOLToolbar;
9503 if Tb.ActiveDesign = nil then
9504 Tb.ActiveDesign := TfmToolbarEditor.Create( Application );
9505 Tb.ActiveDesign.ToolbarControl := Tb;
9506 Tb.ActiveDesign.Visible := TRUE;
9507 SetForegroundWindow( Tb.ActiveDesign.Handle );
9508 Tb.ActiveDesign.MakeActive( TRUE );
9509 if Tb.ParentForm <> nil then
9510 Tb.ParentForm.Invalidate;
9511 end;
9512
9513 function TKOLToolbarButtonsEditor.GetAttributes: TPropertyAttributes;
9514 begin
9515 asm
9516 jmp @@e_signature
9517 DB '#$signature$#', 0
9518 DB 'TKOLToolbarButtonsEditor.GetAttributes', 0
9519 @@e_signature:
9520 end;
9521 Result := [ paDialog, paReadOnly ];
9522 end;
9523
9524 { TKOLToolbarEditor }
9525
9526 procedure TKOLToolbarEditor.Edit;
9527 var Tb: TKOLToolbar;
9528 begin
9529 asm
9530 jmp @@e_signature
9531 DB '#$signature$#', 0
9532 DB 'TKOLToolbarEditor.Edit', 0
9533 @@e_signature:
9534 end;
9535 if Component = nil then Exit;
9536 Tb := Component as TKOLToolbar;
9537 if Tb.ActiveDesign = nil then
9538 Tb.ActiveDesign := TfmToolbarEditor.Create( Application );
9539 Tb.ActiveDesign.ToolbarControl := Tb;
9540 Tb.ActiveDesign.Visible := TRUE;
9541 SetForegroundWindow( Tb.ActiveDesign.Handle );
9542 Tb.ActiveDesign.MakeActive( TRUE );
9543 if Tb.ParentForm <> nil then
9544 Tb.ParentForm.Invalidate;
9545 end;
9546
9547 procedure TKOLToolbarEditor.ExecuteVerb(Index: Integer);
9548 begin
9549 asm
9550 jmp @@e_signature
9551 DB '#$signature$#', 0
9552 DB 'TKOLToolbarEditor.ExecuteVerb', 0
9553 @@e_signature:
9554 end;
9555 Edit;
9556 end;
9557
9558 function TKOLToolbarEditor.GetVerb(Index: Integer): string;
9559 begin
9560 asm
9561 jmp @@e_signature
9562 DB '#$signature$#', 0
9563 DB 'TKOLToolbarEditor.GetVerb', 0
9564 @@e_signature:
9565 end;
9566 Result := '&Edit';
9567 end;
9568
9569 function TKOLToolbarEditor.GetVerbCount: Integer;
9570 begin
9571 asm
9572 jmp @@e_signature
9573 DB '#$signature$#', 0
9574 DB 'TKOLToolbarEditor.GetVerbCount', 0
9575 @@e_signature:
9576 end;
9577 Result := 1;
9578 end;
9579
9580 { TKOLTabControlEditor }
9581
9582 procedure TKOLTabControlEditor.Edit;
9583 var P: TPoint;
9584 C: TComponent;
9585 TabControl: TKOLTabControl;
9586 I: Integer;
9587 R: PRect;
9588 begin
9589 asm
9590 jmp @@e_signature
9591 DB '#$signature$#', 0
9592 DB 'TKOLTabControlEditor.Edit', 0
9593 @@e_signature:
9594 end;
9595 GetCursorPos( P );
9596 C := Component;
9597 if C = nil then Exit;
9598 if not( C is TKOLTabControl ) then Exit;
9599 TabControl := C as TKOLTabControl;
9600 P := TabControl.ScreenToClient( P );
9601 for I := 0 to TabControl.Count-1 do
9602 begin
9603 R := TabControl.FTabs[ I ];
9604 if PtInRect( R^, P ) then
9605 begin
9606 TabControl.CurIndex := I;
9607 break;
9608 end;
9609 end;
9610 end;
9611
9612 procedure TKOLTabControlEditor.ExecuteVerb(Index: Integer);
9613 begin
9614 asm
9615 jmp @@e_signature
9616 DB '#$signature$#', 0
9617 DB 'TKOLTabControlEditor.ExecuteVerb', 0
9618 @@e_signature:
9619 end;
9620 Edit;
9621 end;
9622
9623 function TKOLTabControlEditor.GetVerb(Index: Integer): string;
9624 begin
9625 asm
9626 jmp @@e_signature
9627 DB '#$signature$#', 0
9628 DB 'TKOLTabControlEditor.GetVerb', 0
9629 @@e_signature:
9630 end;
9631 Result := '';
9632 end;
9633
9634 function TKOLTabControlEditor.GetVerbCount: Integer;
9635 begin
9636 asm
9637 jmp @@e_signature
9638 DB '#$signature$#', 0
9639 DB 'TKOLTabControlEditor.GetVerbCount', 0
9640 @@e_signature:
9641 end;
9642 Result := 0;
9643 end;
9644
9645 { TKOLImageShow }
9646
9647 constructor TKOLImageShow.Create(AOwner: TComponent);
9648 begin
9649 asm
9650 jmp @@e_signature
9651 DB '#$signature$#', 0
9652 DB 'TKOLImageShow.Create', 0
9653 @@e_signature:
9654 end;
9655 inherited;
9656 FHasBorder := FALSE;
9657 FDefHasBorder := FALSE;
9658 end;
9659
9660 destructor TKOLImageShow.Destroy;
9661 begin
9662 if ImageListNormal <> nil then
9663 ImageListNormal.NotifyLinkedComponent( Self, noRemoved );
9664 inherited;
9665 end;
9666
9667 procedure TKOLImageShow.DoAutoSize;
9668 var Delta: Integer;
9669 begin
9670 asm
9671 jmp @@e_signature
9672 DB '#$signature$#', 0
9673 DB 'TKOLImageShow.DoAutoSize', 0
9674 @@e_signature:
9675 end;
9676 if not fImgShwAutoSize then Exit;
9677 if FImageListNormal = nil then Exit;
9678 Delta := 0;
9679 if HasBorder then
9680 begin
9681 Inc( Delta, 6 );
9682 end;
9683 Width := FImageListNormal.ImgWidth + Delta;
9684 Height := FImageListNormal.ImgHeight + Delta;
9685 //FAutoSize := TRUE;
9686 fImgShwAutoSize := TRUE;
9687 Change;
9688 end;
9689
9690 function TKOLImageShow.NoDrawFrame: Boolean;
9691 begin
9692 Result := HasBorder;
9693 end;
9694
9695 procedure TKOLImageShow.NotifyLinkedComponent(Sender: TObject;
9696 Operation: TNotifyOperation);
9697 begin
9698 asm
9699 jmp @@e_signature
9700 DB '#$signature$#', 0
9701 DB 'TKOLImageShow.NotifyLinkedComponent', 0
9702 @@e_signature:
9703 end;
9704 inherited;
9705 if Operation = noRemoved then
9706 ImageListNormal := nil;
9707 end;
9708
9709 procedure TKOLImageShow.Paint;
9710 var
9711 R:TRect;
9712 EdgeFlag:DWord;
9713 //Flag:DWord;
9714 Delta:DWord;
9715 TMP:TBitMap;
9716 begin
9717 asm
9718 jmp @@e_signature
9719 DB '#$signature$#', 0
9720 DB 'TKOLImageShow.Paint', 0
9721 @@e_signature:
9722 end;
9723
9724 R.Left:=0;
9725 R.Top:=0;
9726 R.Right:=Width;
9727 R.Bottom:=Height;
9728
9729 if HasBorder then
9730 begin
9731 EdgeFlag:=EDGE_RAISED;
9732 Delta:=3;
9733 end
9734 else
9735 begin
9736 EdgeFlag:=0;
9737 Delta:=0;
9738 end;
9739
9740 if Delta <> 0 then
9741 begin
9742 DrawEdge(Canvas.Handle,R,EdgeFlag,BF_RECT or BF_MIDDLE );
9743 R.Left:=Delta-1;
9744 R.Top:=Delta-1;
9745 R.Right:=Width-Integer( Delta )+1;
9746 R.Bottom:=Height-Integer( Delta )+1;
9747 Canvas.Brush.Color :=clInactiveBorder;
9748 Canvas.FrameRect(R);
9749 R.Left:=R.Left+1;
9750 R.Top:=R.Top+1;
9751 R.Right:=R.Right-1;
9752 R.Bottom:=R.Bottom-1;
9753 Canvas.Brush.Color := Color;
9754 Canvas.FillRect( R );
9755 end;
9756
9757 if ImageListNormal<>nil then
9758 begin
9759 TMP:=TBitMap.Create;
9760 TMP.Width:=ImageListNormal.ImgWidth;
9761 TMP.Height:=ImageListNormal.ImgHeight;
9762
9763 TMP.Canvas.CopyRect(Rect(0,0,ImageListNormal.ImgWidth,ImageListNormal.ImgHeight),ImageListNormal.Bitmap.Canvas,Rect(ImageListNormal.ImgWidth*(CurIndex),0,ImageListNormal.ImgWidth*(CurIndex+1),ImageListNormal.ImgHeight));
9764 {$IFNDEF _D2}
9765 TMP.Transparent:=True;
9766 TMP.TransparentColor:=ImageListNormal.TransparentColor;
9767 {$ENDIF}
9768 Canvas.Draw(Delta,Delta,TMP);
9769 TMP.Free;
9770 end;
9771
9772 inherited;
9773 end;
9774
9775 procedure TKOLImageShow.SetBounds(aLeft, aTop, aWidth, aHeight: Integer);
9776 begin
9777 asm
9778 jmp @@e_signature
9779 DB '#$signature$#', 0
9780 DB 'TKOLImageShow.SetBounds', 0
9781 @@e_signature:
9782 end;
9783 if (aWidth <> Width) or (aHeight <> Height) then
9784 AutoSize := FALSE;
9785 inherited;
9786 Change;
9787 end;
9788
9789 procedure TKOLImageShow.SetCurIndex(const Value: Integer);
9790 begin
9791 asm
9792 jmp @@e_signature
9793 DB '#$signature$#', 0
9794 DB 'TKOLImageShow.SetCurIndex', 0
9795 @@e_signature:
9796 end;
9797 FCurIndex := Value;
9798 Change;
9799 Invalidate;
9800 end;
9801
9802 procedure TKOLImageShow.SetHasBorder(const Value: Boolean);
9803 var WasAuto: Boolean;
9804 begin
9805 asm
9806 jmp @@e_signature
9807 DB '#$signature$#', 0
9808 DB 'TKOLImageShow.SetHasBorder', 0
9809 @@e_signature:
9810 end;
9811 WasAuto := AutoSize;
9812 inherited;
9813 AutoSize := WasAuto;
9814 if AutoSize then DoAutoSize;
9815 Change;
9816 end;
9817
9818 procedure TKOLImageShow.SetImageListNormal(const Value: TKOLImageList);
9819 begin
9820 asm
9821 jmp @@e_signature
9822 DB '#$signature$#', 0
9823 DB 'TKOLImageShow.SetImageListNormal', 0
9824 @@e_signature:
9825 end;
9826 if FImageListNormal <> nil then
9827 FImageListNormal.NotifyLinkedComponent( Self, noRemoved );
9828 FImageListNormal := Value;
9829 if Value <> nil then
9830 begin
9831 Value.AddToNotifyList( Self );
9832 if Value.ImgWidth * Value.ImgHeight > 0 then
9833 begin
9834 if AutoSize then
9835 DoAutoSize;
9836 end;
9837 end;
9838 DoAutoSize;
9839 Change;
9840 Invalidate;
9841 end;
9842
9843 procedure TKOLImageShow.SetImgShwAutoSize(const Value: Boolean);
9844 begin
9845 asm
9846 jmp @@e_signature
9847 DB '#$signature$#', 0
9848 DB 'TKOLImageShow.SetImgShwAutoSize', 0
9849 @@e_signature:
9850 end;
9851 fImgShwAutoSize := Value;
9852 //Change;
9853 if Value then
9854 DoAutoSize;
9855 end;
9856
9857 procedure TKOLImageShow.SetpopupMenu(const Value: TKOLPopupMenu);
9858 begin
9859 asm
9860 jmp @@e_signature
9861 DB '#$signature$#', 0
9862 DB 'TKOLImageShow.SetpopupMenu', 0
9863 @@e_signature:
9864 end;
9865 FpopupMenu := Value;
9866 Change;
9867 end;
9868
9869 procedure TKOLImageShow.SetupFirst(SL: TStringList; const AName, AParent,
9870 Prefix: String);
9871 begin
9872 asm
9873 jmp @@e_signature
9874 DB '#$signature$#', 0
9875 DB 'TKOLImageShow.SetupFirst', 0
9876 @@e_signature:
9877 end;
9878 inherited;
9879 if CurIndex <> 0 then
9880 SL.Add( Prefix + AName + '.CurIndex := ' + IntToStr( CurIndex ) + ';' );
9881 if Assigned( FpopupMenu ) then
9882 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
9883 ' );' );
9884 end;
9885
9886 function TKOLImageShow.SetupParams(const AName, AParent: String): String;
9887 begin
9888 asm
9889 jmp @@e_signature
9890 DB '#$signature$#', 0
9891 DB 'TKOLImageShow.SetupParams', 0
9892 @@e_signature:
9893 end;
9894 Result := AParent + ', ';
9895 if ImageListNormal <> nil then
9896 begin
9897 if ImageListNormal.ParentFORM.Name = ParentForm.Name then
9898 Result := Result + 'Result.' + ImageListNormal.Name
9899 else Result := Result + ImageListNormal.ParentFORM.Name +'.'+ ImageListNormal.Name;
9900 end
9901 else
9902 Result := Result + 'nil';
9903 Result := Result + ', ' + IntToStr( CurIndex );
9904 end;
9905
9906 function TKOLImageShow.WYSIWIGPaintImplemented: Boolean;
9907 begin
9908 Result := TRUE;
9909 end;
9910
9911 { TKOLLabelEffect }
9912
9913 function TKOLLabelEffect.AdjustVerticalAlign(
9914 Value: TVerticalAlign): TVerticalAlign;
9915 begin
9916 asm
9917 jmp @@e_signature
9918 DB '#$signature$#', 0
9919 DB 'TKOLLabelEffect.AdjustVerticalAlign', 0
9920 @@e_signature:
9921 end;
9922 Result := Value;
9923 end;
9924
9925 function TKOLLabelEffect.AutoHeight(Canvas: TCanvas): Integer;
9926 begin
9927 asm
9928 jmp @@e_signature
9929 DB '#$signature$#', 0
9930 DB 'TKOLLabelEffect.AutoHeight', 0
9931 @@e_signature:
9932 end;
9933 Result := inherited AutoHeight(Canvas);
9934 if Font.FontOrientation = 0 then Exit;
9935 try
9936 Result := Trunc( Result * cos( Font.FontOrientation / 1800 * PI ) +
9937 inherited AutoWidth(Canvas) * sin( Font.FontOrientation / 1800 * PI ) );
9938 except
9939 end;
9940 end;
9941
9942 function TKOLLabelEffect.AutoWidth(Canvas: TCanvas): Integer;
9943 begin
9944 asm
9945 jmp @@e_signature
9946 DB '#$signature$#', 0
9947 DB 'TKOLLabelEffect.AutoWidth', 0
9948 @@e_signature:
9949 end;
9950 Result := inherited AutoWidth(Canvas);
9951 if Font.FontOrientation = 0 then Exit;
9952 try
9953 Result := Trunc( Result * cos( Font.FontOrientation / 1800 * PI ) +
9954 inherited AutoHeight(Canvas) * sin( Font.FontOrientation / 1800 * PI ) );
9955 except
9956 end;
9957 end;
9958
9959 constructor TKOLLabelEffect.Create(AOwner: TComponent);
9960 begin
9961 asm
9962 jmp @@e_signature
9963 DB '#$signature$#', 0
9964 DB 'TKOLLabelEffect.Create', 0
9965 @@e_signature:
9966 end;
9967 inherited;
9968 //Color := clWindowText;
9969 fColor2 := clNone;
9970 Ctl3D := FALSE;
9971 end;
9972
9973 procedure TKOLLabelEffect.Paint;
9974 var
9975 R:TRect;
9976 Flag:DWord;
9977 begin
9978
9979 PrepareCanvasFontForWYSIWIGPaint( Canvas );
9980
9981 R.Left:=ShadowDeep;
9982 R.Top:=ShadowDeep;
9983 R.Right:=Width+ShadowDeep;
9984 R.Bottom:=Height+ShadowDeep;
9985 Flag:=0;
9986 case TextAlign of
9987 taRight: Flag:=Flag or DT_RIGHT;
9988 taLeft: Flag:=Flag or DT_LEFT;
9989 taCenter: Flag:=Flag or DT_CENTER;
9990 end;
9991
9992 case VerticalAlign of
9993 vaTop: Flag:=Flag or DT_TOP or DT_SINGLELINE;
9994 vaBottom: Flag:=Flag or DT_BOTTOM or DT_SINGLELINE;
9995 vaCenter: Flag:=Flag or DT_VCENTER or DT_SINGLELINE;
9996 end;
9997
9998 if (WordWrap) and (not AutoSize) then
9999 Flag:=Flag or DT_WORDBREAK and not DT_SINGLELINE;
10000 Canvas.Font.Color:=Color2;
10001 DrawText(Canvas.Handle,PChar(Caption),Length(Caption),R,Flag);
10002
10003 inherited;
10004
10005 end;
10006
10007 procedure TKOLLabelEffect.SetColor2(const Value: TColor);
10008 begin
10009 asm
10010 jmp @@e_signature
10011 DB '#$signature$#', 0
10012 DB 'TKOLLabelEffect.SetColor2', 0
10013 @@e_signature:
10014 end;
10015 FColor2 := Value;
10016 Change;
10017 Invalidate;
10018 end;
10019
10020 procedure TKOLLabelEffect.SetShadowDeep(const Value: Integer);
10021 begin
10022 asm
10023 jmp @@e_signature
10024 DB '#$signature$#', 0
10025 DB 'TKOLLabelEffect.SetShadowDeep', 0
10026 @@e_signature:
10027 end;
10028 FShadowDeep := Value;
10029 Change;
10030 Invalidate;
10031 end;
10032
10033 procedure TKOLLabelEffect.SetupFirst(SL: TStringList; const AName, AParent,
10034 Prefix: String);
10035 begin
10036 asm
10037 jmp @@e_signature
10038 DB '#$signature$#', 0
10039 DB 'TKOLLabelEffect.SetupFirst', 0
10040 @@e_signature:
10041 end;
10042 inherited;
10043 if Color2 <> clNone then
10044 SL.Add( Prefix + AName + '.Color2 := ' + Color2Str( Color2 ) + ';' );
10045 if Ctl3D then
10046 SL.Add( Prefix + AName + '.Ctl3D := TRUE;' );
10047 end;
10048
10049 function TKOLLabelEffect.SetupParams(const AName, AParent: String): String;
10050 begin
10051 asm
10052 jmp @@e_signature
10053 DB '#$signature$#', 0
10054 DB 'TKOLLabelEffect.SetupParams', 0
10055 @@e_signature:
10056 end;
10057 Result := AParent + ', ' + StringConstant('Caption', Caption) + ', ' +
10058 Int2Str( ShadowDeep );
10059 end;
10060
10061 procedure TKOLLabelEffect.SetupTextAlign(SL: TStrings;
10062 const AName: String);
10063 begin
10064 asm
10065 jmp @@e_signature
10066 DB '#$signature$#', 0
10067 DB 'TKOLLabelEffect.SetupTextAlign', 0
10068 @@e_signature:
10069 end;
10070 if TextAlign <> taCenter then
10071 SL.Add( ' ' + AName + '.TextAlign := ' + TextAligns[ TextAlign ] + ';' );
10072 if VerticalAlign <> vaTop then
10073 SL.Add( ' ' + AName + '.VerticalAlign := ' + VertAligns[ VerticalAlign ] + ';' );
10074 end;
10075
10076 { TKOLScrollBox }
10077
10078 constructor TKOLScrollBox.Create(AOwner: TComponent);
10079 begin
10080 asm
10081 jmp @@e_signature
10082 DB '#$signature$#', 0
10083 DB 'TKOLScrollBox.Create', 0
10084 @@e_signature:
10085 end;
10086 inherited;
10087 FEdgeStyle := esLowered;
10088 FScrollBars := ssBoth;
10089 ControlStyle := ControlStyle + [ csAcceptsControls ];
10090 end;
10091
10092 function TKOLScrollBox.IsControlContainer: Boolean;
10093 var I: Integer;
10094 C: TComponent;
10095 K: TControl;
10096 begin
10097 asm
10098 jmp @@e_signature
10099 DB '#$signature$#', 0
10100 DB 'TKOLScrollBox.IsControlContainer', 0
10101 @@e_signature:
10102 end;
10103 Result := ControlContainer;
10104 if Result then Exit;
10105 if Owner = nil then Exit;
10106 for I := 0 to Owner.ComponentCount - 1 do
10107 begin
10108 C := Owner.Components[ I ];
10109 if C is TControl then
10110 begin
10111 K := C as TControl;
10112 if K.Parent = Self then
10113 begin
10114 Result := TRUE;
10115 Exit;
10116 end;
10117 end;
10118 end;
10119 end;
10120
10121 procedure TKOLScrollBox.SetControlContainer(const Value: Boolean);
10122 begin
10123 asm
10124 jmp @@e_signature
10125 DB '#$signature$#', 0
10126 DB 'TKOLScrollBox.SetControlContainer', 0
10127 @@e_signature:
10128 end;
10129 FControlContainer := Value;
10130 Change;
10131 end;
10132
10133 procedure TKOLScrollBox.SetEdgeStyle(const Value: TEdgeStyle);
10134 begin
10135 asm
10136 jmp @@e_signature
10137 DB '#$signature$#', 0
10138 DB 'TKOLScrollBox.SetEdgeStyle', 0
10139 @@e_signature:
10140 end;
10141 FEdgeStyle := Value;
10142 ReAlign( FALSE );
10143 Change;
10144 end;
10145
10146 procedure TKOLScrollBox.SetpopupMenu(const Value: TKOLPopupMenu);
10147 begin
10148 asm
10149 jmp @@e_signature
10150 DB '#$signature$#', 0
10151 DB 'TKOLScrollBox.SetpopupMenu', 0
10152 @@e_signature:
10153 end;
10154 FpopupMenu := Value;
10155 Change;
10156 end;
10157
10158 procedure TKOLScrollBox.SetScrollBars(const Value: TScrollBars);
10159 begin
10160 asm
10161 jmp @@e_signature
10162 DB '#$signature$#', 0
10163 DB 'TKOLScrollBox.SetScrollBars', 0
10164 @@e_signature:
10165 end;
10166 FScrollBars := Value;
10167 Change;
10168 end;
10169
10170 procedure TKOLScrollBox.SetupFirst(SL: TStringList; const AName, AParent,
10171 Prefix: String);
10172 begin
10173 asm
10174 jmp @@e_signature
10175 DB '#$signature$#', 0
10176 DB 'TKOLScrollBox.SetupFirst', 0
10177 @@e_signature:
10178 end;
10179 inherited;
10180 if Assigned( FpopupMenu ) then
10181 SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +
10182 ' );' );
10183 end;
10184
10185 function TKOLScrollBox.SetupParams(const AName, AParent: String): String;
10186 const EdgeStyles: array[ TEdgeStyle ] of String = ( 'esRaised', 'esLowered', 'esNone' );
10187 var S: String;
10188 begin
10189 asm
10190 jmp @@e_signature
10191 DB '#$signature$#', 0
10192 DB 'TKOLScrollBox.SetupParams', 0
10193 @@e_signature:
10194 end;
10195 Result := AParent + ', ' + EdgeStyles[ EdgeStyle ];
10196 if not IsControlContainer then
10197 begin
10198 S := '';
10199 case ScrollBars of
10200 ssHorz: S := 'sbHorizontal';
10201 ssVert: S := 'sbVertical';
10202 ssBoth: S := 'sbHorizontal, sbVertical';
10203 end;
10204 Result := Result + ', [ ' + S + ' ]';
10205 end;
10206 end;
10207
10208 function TKOLScrollBox.TypeName: String;
10209 begin
10210 asm
10211 jmp @@e_signature
10212 DB '#$signature$#', 0
10213 DB 'TKOLScrollBox.TypeName', 0
10214 @@e_signature:
10215 end;
10216 Result := inherited TypeName;
10217 if IsControlContainer then
10218 Result := 'ScrollBoxEx';
10219 end;
10220
10221 { TKOLMDIClient }
10222
10223 var MDIWarningLastTime: Integer;
10224 procedure MDIClientMustBeAChildOfTheFormWarning;
10225 begin
10226 asm
10227 jmp @@e_signature
10228 DB '#$signature$#', 0
10229 DB 'MDIClientMustBeAChildOfTheFormWarning', 0
10230 @@e_signature:
10231 end;
10232 if Abs( Integer( GetTickCount ) - MDIWarningLastTime ) > 60000 then
10233 begin
10234 MDIWarningLastTime := GetTickCount;
10235 ShowMessage( 'TKOLMDIClient control must be a child of the form itself!'#13 +
10236 'Otherwise maximizing of MDI children will lead to access violation ' +
10237 'at run-time execution.' );
10238 end;
10239 end;
10240
10241 procedure MsgDuplicatedMDIClient;
10242 begin
10243 asm
10244 jmp @@e_signature
10245 DB '#$signature$#', 0
10246 DB 'MsgDuplicatedMDIClient', 0
10247 @@e_signature:
10248 end;
10249 if Abs( Integer( GetTickCount ) - MDIWarningLastTime ) > 60000 then
10250 begin
10251 MDIWarningLastTime := GetTickCount;
10252 ShowMessage( 'TKOLMDIClient control must be a single on the form, ' +
10253 'but another instance of MDI client object found there.' );
10254 end;
10255 end;
10256
10257 constructor TKOLMDIClient.Create(AOwner: TComponent);
10258 var I: Integer;
10259 C: TComponent;
10260 begin
10261 asm
10262 jmp @@e_signature
10263 DB '#$signature$#', 0
10264 DB 'TKOLMDIClient.Create', 0
10265 @@e_signature:
10266 end;
10267 inherited;
10268 Align := caClient;
10269 if (AOwner <> nil) and (AOwner is TForm) then
10270 begin
10271 for I := 0 to (AOwner as TForm).ComponentCount-1 do
10272 begin
10273 C := (AOwner as TForm).Components[ I ];
10274 if C = Self then continue;
10275 if C is TKOLMDIClient then
10276 begin
10277 MsgDuplicatedMDIClient;
10278 break;
10279 end;
10280 end;
10281 end;
10282 FTimer := TTimer.Create( Self );
10283 FTimer.Interval := 200;
10284 FTimer.OnTimer := Tick;
10285 FTimer.Enabled := TRUE;
10286 end;
10287
10288 destructor TKOLMDIClient.Destroy;
10289 begin
10290 asm
10291 jmp @@e_signature
10292 DB '#$signature$#', 0
10293 DB 'TKOLMDIClient.Destroy', 0
10294 @@e_signature:
10295 end;
10296 inherited;
10297 MDIWarningLastTime := 0;
10298 end;
10299
10300 function TKOLMDIClient.SetupParams(const AName, AParent: String): String;
10301
10302 function FindWindowMenu( MI: TKOLMenuItem ): Integer;
10303 var I: Integer;
10304 SMI: TKOLMenuItem;
10305 begin
10306 Result := 0;
10307 if MI.WindowMenu then
10308 Result := MI.itemindex
10309 else
10310 for I := 0 to MI.Count-1 do
10311 begin
10312 SMI := MI.SubItems[ I ];
10313 Result := FindWindowMenu( SMI );
10314 if Result > 0 then
10315 break;
10316 end;
10317 end;
10318
10319 var I, J, WM: Integer;
10320 C: TComponent;
10321 MM: TKOLMainMenu;
10322 MI: TKOLMenuItem;
10323 S: String;
10324 begin
10325 asm
10326 jmp @@e_signature
10327 DB '#$signature$#', 0
10328 DB 'TKOLMDIClient.SetupParams', 0
10329 @@e_signature:
10330 end;
10331 Result := AParent + ', ';
10332 S := '0';
10333 for I := 0 to (Owner as TForm).ComponentCount-1 do
10334 begin
10335 C := (Owner as TForm).Components[ I ];
10336 if C is TKOLMainMenu then
10337 begin
10338 MM := C as TKOLMainMenu;
10339 for J := 0 to MM.Count-1 do
10340 begin
10341 MI := MM.Items[ J ];
10342 WM := FindWindowMenu( MI );
10343 if WM > 0 then
10344 begin
10345 S := 'Result.' + MM.Name + '.ItemHandle[ ' +
10346 IntToStr( WM ) + ' ]';
10347 break;
10348 end;
10349 end;
10350 break;
10351 end;
10352 end;
10353 Result := Result + S;
10354 end;
10355
10356 procedure TKOLMDIClient.Tick(Sender: TObject);
10357 begin
10358 asm
10359 jmp @@e_signature
10360 DB '#$signature$#', 0
10361 DB 'TKOLMDIClient.Tick', 0
10362 @@e_signature:
10363 end;
10364 if Parent <> nil then
10365 begin
10366 FTimer.Enabled := FALSE;
10367 if Parent <> Owner then
10368 MDIClientMustBeAChildOfTheFormWarning
10369 else
10370 ParentKOLForm.AlignChildren( nil, FALSE );
10371 FTimer.Free;
10372 FTimer := nil;
10373 end;
10374 end;
10375
10376 { TKOLToolbarButton }
10377
10378 procedure TKOLToolbarButton.Change;
10379 begin
10380 asm
10381 jmp @@e_signature
10382 DB '#$signature$#', 0
10383 DB 'TKOLToolbarButton.Change', 0
10384 @@e_signature:
10385 end;
10386 if csLoading in ComponentState then Exit;
10387 if FToolbar <> nil then begin
10388 FToolbar.UpdateButtons;
10389 FToolbar.Change;
10390 end;
10391 end;
10392
10393 constructor TKOLToolbarButton.Create(AOwner: TComponent);
10394 begin
10395 asm
10396 jmp @@e_signature
10397 DB '#$signature$#', 0
10398 DB 'TKOLToolbarButton.Create', 0
10399 @@e_signature:
10400 end;
10401 inherited;
10402 if AOwner <> nil then
10403 if AOwner is TKOLToolbar then
10404 begin
10405 FToolbar := AOwner as TKOLToolbar;
10406 FToolbar.FItems.Add( Self );
10407 end;
10408 Fpicture := TPicture.Create;
10409 Fvisible := TRUE;
10410 Fenabled := TRUE;
10411 FimgIndex := -1;
10412 end;
10413
10414 procedure TKOLToolbarButton.DefProps(const Prefix: String; Filer: Tfiler);
10415 begin
10416 asm
10417 jmp @@e_signature
10418 DB '#$signature$#', 0
10419 DB 'TKOLToolbarButton.DefProps', 0
10420 @@e_signature:
10421 end;
10422 Filer.DefineProperty( Prefix + 'Name', LoadName, SaveName, TRUE );
10423 Filer.DefineProperty( Prefix + 'caption', LoadCaption, SaveCaption, TRUE );
10424 Filer.DefineProperty( Prefix + 'checked', LoadChecked, SaveChecked, TRUE );
10425 Filer.DefineProperty( Prefix + 'dropdown', LoadDropDown, SaveDropDown, TRUE );
10426 Filer.DefineProperty( Prefix + 'enabled', LoadEnabled, SaveEnabled, TRUE );
10427 Filer.DefineProperty( Prefix + 'separator', LoadSeparator, SaveSeparator, TRUE );
10428 Filer.DefineProperty( Prefix + 'tooltip', LoadTooltip, SaveTooltip, TRUE );
10429 Filer.DefineProperty( Prefix + 'visible', LoadVisible, SaveVisible, TRUE );
10430 Filer.DefineProperty( Prefix + 'onClick', LoadOnClick, SaveOnClick, TRUE );
10431 Filer.DefineProperty( Prefix + 'picture', LoadPicture, SavePicture, TRUE );
10432 Filer.DefineProperty( Prefix + 'sysimg', LoadSysImg, SaveSysImg, TRUE );
10433 Filer.DefineProperty( Prefix + 'radioGroup', LoadRadioGroup, SaveRadioGroup, radioGroup <> 0 );
10434 Filer.DefineProperty( Prefix + 'imgIndex', LoadImgIndex, SaveImgIndex, imgIndex >= 0 );
10435 end;
10436
10437 destructor TKOLToolbarButton.Destroy;
10438 begin
10439 asm
10440 jmp @@e_signature
10441 DB '#$signature$#', 0
10442 DB 'TKOLToolbarButton.Destroy', 0
10443 @@e_signature:
10444 end;
10445 if FToolbar <> nil then
10446 FToolbar.FItems.Remove( Self );
10447 Fpicture.Free;
10448 inherited;
10449 end;
10450
10451 function TKOLToolbarButton.HasPicture: Boolean;
10452 begin
10453 asm
10454 jmp @@e_signature
10455 DB '#$signature$#', 0
10456 DB 'TKOLToolbarButton.HasPicture', 0
10457 @@e_signature:
10458 end;
10459 {if Assigned( picture ) then
10460 Rpt( '%%%%%%%% ' + Name + '.picture: Width=' + Int2Str( picture.Width ) +
10461 ' Height=' + Int2Str( picture.Height ) );}
10462 Result := Assigned( picture ) and (picture.Width * picture.Height > 0);
10463 end;
10464
10465 procedure TKOLToolbarButton.LoadCaption(Reader: TReader);
10466 begin
10467 asm
10468 jmp @@e_signature
10469 DB '#$signature$#', 0
10470 DB 'TKOLToolbarButton.LoadCaption', 0
10471 @@e_signature:
10472 end;
10473 Fcaption := Reader.ReadString;
10474 end;
10475
10476 procedure TKOLToolbarButton.LoadChecked(Reader: TReader);
10477 begin
10478 asm
10479 jmp @@e_signature
10480 DB '#$signature$#', 0
10481 DB 'TKOLToolbarButton.LoadChecked', 0
10482 @@e_signature:
10483 end;
10484 Fchecked := Reader.ReadBoolean;
10485 end;
10486
10487 procedure TKOLToolbarButton.LoadDropDown(Reader: TReader);
10488 begin
10489 asm
10490 jmp @@e_signature
10491 DB '#$signature$#', 0
10492 DB 'TKOLToolbarButton.LoadDropDown', 0
10493 @@e_signature:
10494 end;
10495 Fdropdown := Reader.ReadBoolean;
10496 end;
10497
10498 procedure TKOLToolbarButton.LoadEnabled(Reader: TReader);
10499 begin
10500 asm
10501 jmp @@e_signature
10502 DB '#$signature$#', 0
10503 DB 'TKOLToolbarButton.LoadEnabled', 0
10504 @@e_signature:
10505 end;
10506 Fenabled := Reader.ReadBoolean;
10507 end;
10508
10509 procedure TKOLToolbarButton.LoadImgIndex(Reader: TReader);
10510 begin
10511 FimgIndex := Reader.ReadInteger;
10512 end;
10513
10514 procedure TKOLToolbarButton.LoadName(Reader: TReader);
10515 var S: String;
10516 begin
10517 asm
10518 jmp @@e_signature
10519 DB '#$signature$#', 0
10520 DB 'TKOLToolbarButton.LoadName', 0
10521 @@e_signature:
10522 end;
10523 S := Reader.ReadString;
10524 if FToolbar = nil then Exit;
10525 if FToolbar.FindComponent( S ) <> nil then Exit;
10526 if (FToolbar.Owner <> nil) and (FToolbar.Owner is TForm) then
10527 begin
10528 if (FToolbar.Owner as TForm).FindComponent( S ) <> nil then Exit;
10529 Name := S;
10530 end;
10531 end;
10532
10533 procedure TKOLToolbarButton.LoadOnClick(Reader: TReader);
10534 begin
10535 asm
10536 jmp @@e_signature
10537 DB '#$signature$#', 0
10538 DB 'TKOLToolbarButton.LoadOnClick', 0
10539 @@e_signature:
10540 end;
10541 fOnClickMethodName := Reader.ReadString;
10542 end;
10543
10544 procedure TKOLToolbarButton.LoadPicture(Reader: TReader);
10545 var S: String;
10546 MS: TMemoryStream;
10547 Bmp: TBitmap;
10548 begin
10549 asm
10550 jmp @@e_signature
10551 DB '#$signature$#', 0
10552 DB 'TKOLToolbarButton.LoadPicture', 0
10553 @@e_signature:
10554 end;
10555 S := Reader.ReadString;
10556 //ShowMessage( 'Read picture: <' + S + '>' );
10557 if Trim( S ) <> '' then
10558 begin
10559 MS := TMemoryStream.Create;
10560 TRY
10561 MS.Write( S[ 1 ], Length( S ) );
10562 MS.Position := 0;
10563 Bmp := TBitmap.Create;
10564 TRY
10565 Bmp.LoadFromStream( MS );
10566 Fpicture.Assign( Bmp );
10567 FINALLY
10568 Bmp.Free;
10569 END;
10570 FINALLY
10571 MS.Free;
10572 END;
10573 end;
10574 //ShowMessage( 'Read picture - end' );
10575 end;
10576
10577 procedure TKOLToolbarButton.LoadProps(Reader: TReader);
10578 begin
10579 asm
10580 jmp @@e_signature
10581 DB '#$signature$#', 0
10582 DB 'TKOLToolbarButton.LoadProps', 0
10583 @@e_signature:
10584 end;
10585 Fcaption := Reader.ReadString;
10586 Fchecked := Reader.ReadBoolean;
10587 Fdropdown := Reader.ReadBoolean;
10588 Fenabled := Reader.ReadBoolean;
10589 Fseparator := Reader.ReadBoolean;
10590 Ftooltip := Reader.ReadString;
10591 Fvisible := Reader.ReadBoolean;
10592 fOnClickMethodName := Reader.ReadString;
10593 end;
10594
10595 procedure TKOLToolbarButton.LoadRadioGroup(Reader: TReader);
10596 begin
10597 asm
10598 jmp @@e_signature
10599 DB '#$signature$#', 0
10600 DB 'TKOLToolbarButton.LoadRadioGroup', 0
10601 @@e_signature:
10602 end;
10603 FradioGroup := Reader.ReadInteger;
10604 end;
10605
10606 procedure TKOLToolbarButton.LoadSeparator(Reader: TReader);
10607 begin
10608 asm
10609 jmp @@e_signature
10610 DB '#$signature$#', 0
10611 DB 'TKOLToolbarButton.LoadSeparator', 0
10612 @@e_signature:
10613 end;
10614 Fseparator := Reader.ReadBoolean;
10615 end;
10616
10617 procedure TKOLToolbarButton.LoadSysImg(Reader: TReader);
10618 begin
10619 Fsysimg := TSystemToolbarImage( Reader.ReadInteger );
10620 end;
10621
10622 procedure TKOLToolbarButton.LoadTooltip(Reader: TReader);
10623 begin
10624 asm
10625 jmp @@e_signature
10626 DB '#$signature$#', 0
10627 DB 'TKOLToolbarButton.LoadTooltip', 0
10628 @@e_signature:
10629 end;
10630 Ftooltip := Reader.ReadString;
10631 end;
10632
10633 procedure TKOLToolbarButton.LoadVisible(Reader: TReader);
10634 begin
10635 asm
10636 jmp @@e_signature
10637 DB '#$signature$#', 0
10638 DB 'TKOLToolbarButton.LoadVisible', 0
10639 @@e_signature:
10640 end;
10641 Fvisible := Reader.ReadBoolean;
10642 end;
10643
10644 procedure TKOLToolbarButton.Notification(AComponent: TComponent; Operation: TOperation);
10645 begin
10646 inherited;
10647 if Operation = opRemove then
10648 if AComponent = Faction then begin
10649 Faction.UnLinkComponent(Self);
10650 Faction := nil;
10651 end;
10652 end;
10653
10654 procedure TKOLToolbarButton.SaveCaption(Writer: TWriter);
10655 begin
10656 asm
10657 jmp @@e_signature
10658 DB '#$signature$#', 0
10659 DB 'TKOLToolbarButton.SaveCaption', 0
10660 @@e_signature:
10661 end;
10662 Writer.WriteString( Fcaption );
10663 end;
10664
10665 procedure TKOLToolbarButton.SaveChecked(Writer: TWriter);
10666 begin
10667 asm
10668 jmp @@e_signature
10669 DB '#$signature$#', 0
10670 DB 'TKOLToolbarButton.SaveChecked', 0
10671 @@e_signature:
10672 end;
10673 Writer.WriteBoolean( Fchecked );
10674 end;
10675
10676 procedure TKOLToolbarButton.SaveDropDown(Writer: TWriter);
10677 begin
10678 asm
10679 jmp @@e_signature
10680 DB '#$signature$#', 0
10681 DB 'TKOLToolbarButton.SaveDropDown', 0
10682 @@e_signature:
10683 end;
10684 Writer.WriteBoolean( Fdropdown );
10685 end;
10686
10687 procedure TKOLToolbarButton.SaveEnabled(Writer: TWriter);
10688 begin
10689 asm
10690 jmp @@e_signature
10691 DB '#$signature$#', 0
10692 DB 'TKOLToolbarButton.SaveEnabled', 0
10693 @@e_signature:
10694 end;
10695 Writer.WriteBoolean( Fenabled );
10696 end;
10697
10698 procedure TKOLToolbarButton.SaveImgIndex(Writer: TWriter);
10699 begin
10700 Writer.WriteInteger( FimgIndex );
10701 end;
10702
10703 procedure TKOLToolbarButton.SaveName(Writer: TWriter);
10704 begin
10705 asm
10706 jmp @@e_signature
10707 DB '#$signature$#', 0
10708 DB 'TKOLToolbarButton.SaveName', 0
10709 @@e_signature:
10710 end;
10711 Writer.WriteString( Name );
10712 end;
10713
10714 procedure TKOLToolbarButton.SaveOnClick(Writer: TWriter);
10715 begin
10716 asm
10717 jmp @@e_signature
10718 DB '#$signature$#', 0
10719 DB 'TKOLToolbarButton.SaveOnClick', 0
10720 @@e_signature:
10721 end;
10722 Writer.WriteString( fOnClickMethodName );
10723 end;
10724
10725 procedure TKOLToolbarButton.SavePicture(Writer: TWriter);
10726 var S: String;
10727 MS: TMemoryStream;
10728 Bmp: TBitmap;
10729 begin
10730 asm
10731 jmp @@e_signature
10732 DB '#$signature$#', 0
10733 DB 'TKOLToolbarButton.SavePicture', 0
10734 @@e_signature:
10735 end;
10736 MS := TMemoryStream.Create;
10737 TRY
10738 S := '';
10739 if Assigned( picture ) and (picture.Width * picture.Height > 0) then
10740 begin
10741 Bmp := TBitmap.Create;
10742 TRY
10743 Bmp.Assign( picture.Graphic );
10744 Bmp.SaveToStream( MS );
10745 FINALLY
10746 Bmp.Free;
10747 END;
10748 SetLength( S, MS.Size );
10749 Move( MS.Memory^, S[ 1 ], MS.Size );
10750 end;
10751 Writer.WriteString( S );
10752 FINALLY
10753 MS.Free;
10754 END;
10755 end;
10756
10757 procedure TKOLToolbarButton.SaveProps(Writer: TWriter);
10758 begin
10759 asm
10760 jmp @@e_signature
10761 DB '#$signature$#', 0
10762 DB 'TKOLToolbarButton.SaveProps', 0
10763 @@e_signature:
10764 end;
10765 Writer.WriteString( Fcaption );
10766 Writer.WriteBoolean( Fchecked );
10767 Writer.WriteBoolean( Fdropdown );
10768 Writer.WriteBoolean( Fenabled );
10769 Writer.WriteBoolean( Fseparator );
10770 Writer.WriteString( Ftooltip );
10771 Writer.WriteBoolean( Fvisible );
10772 Writer.WriteString( fOnClickMethodName );
10773 end;
10774
10775 procedure TKOLToolbarButton.SaveRadioGroup(Writer: TWriter);
10776 begin
10777 asm
10778 jmp @@e_signature
10779 DB '#$signature$#', 0
10780 DB 'TKOLToolbarButton.SaveRadioGroup', 0
10781 @@e_signature:
10782 end;
10783 Writer.WriteInteger( FradioGroup );
10784 end;
10785
10786 procedure TKOLToolbarButton.SaveSeparator(Writer: TWriter);
10787 begin
10788 asm
10789 jmp @@e_signature
10790 DB '#$signature$#', 0
10791 DB 'TKOLToolbarButton.SaveSeparator', 0
10792 @@e_signature:
10793 end;
10794 Writer.WriteBoolean( Fseparator );
10795 end;
10796
10797 procedure TKOLToolbarButton.SaveSysImg(Writer: TWriter);
10798 begin
10799 Writer.WriteInteger( Integer( Fsysimg ) );
10800 end;
10801
10802 procedure TKOLToolbarButton.SaveTooltip(Writer: TWriter);
10803 begin
10804 asm
10805 jmp @@e_signature
10806 DB '#$signature$#', 0
10807 DB 'TKOLToolbarButton.SaveTooltip', 0
10808 @@e_signature:
10809 end;
10810 Writer.WriteString( Ftooltip );
10811 end;
10812
10813 procedure TKOLToolbarButton.SaveVisible(Writer: TWriter);
10814 begin
10815 asm
10816 jmp @@e_signature
10817 DB '#$signature$#', 0
10818 DB 'TKOLToolbarButton.SaveVisible', 0
10819 @@e_signature:
10820 end;
10821 Writer.WriteBoolean( Fvisible );
10822 end;
10823
10824 procedure TKOLToolbarButton.Setaction(const Value: TKOLAction);
10825 begin
10826 if Faction = Value then exit;
10827 if Faction <> nil then
10828 Faction.UnLinkComponent(Self);
10829 Faction := Value;
10830 if Faction <> nil then
10831 Faction.LinkComponent(Self);
10832 Change;
10833 end;
10834
10835 procedure TKOLToolbarButton.Setcaption(const Value: String);
10836 begin
10837 asm
10838 jmp @@e_signature
10839 DB '#$signature$#', 0
10840 DB 'TKOLToolbarButton.Setcaption', 0
10841 @@e_signature:
10842 end;
10843 if Fcaption = Value then Exit;
10844 if Faction = nil then
10845 Fcaption := Value
10846 else
10847 Fcaption:=Faction.Caption;
10848 if Fcaption <> '-' then
10849 Fseparator := FALSE;
10850 Change;
10851 end;
10852
10853 procedure TKOLToolbarButton.Setchecked(const Value: Boolean);
10854 begin
10855 asm
10856 jmp @@e_signature
10857 DB '#$signature$#', 0
10858 DB 'TKOLToolbarButton.Setchecked', 0
10859 @@e_signature:
10860 end;
10861 if FChecked = Value then Exit;
10862 if Faction = nil then
10863 FChecked := Value
10864 else
10865 FChecked:=Faction.Checked;
10866 Change;
10867 end;
10868
10869 procedure TKOLToolbarButton.Setdropdown(const Value: Boolean);
10870 begin
10871 asm
10872 jmp @@e_signature
10873 DB '#$signature$#', 0
10874 DB 'TKOLToolbarButton.Setdropdown', 0
10875 @@e_signature:
10876 end;
10877 if Fdropdown = Value then Exit;
10878 Fdropdown := Value;
10879 Change;
10880 end;
10881
10882 procedure TKOLToolbarButton.Setenabled(const Value: Boolean);
10883 begin
10884 asm
10885 jmp @@e_signature
10886 DB '#$signature$#', 0
10887 DB 'TKOLToolbarButton.Setenabled', 0
10888 @@e_signature:
10889 end;
10890 if Fenabled = Value then Exit;
10891 if Faction = nil then
10892 Fenabled := Value
10893 else
10894 Fenabled:=Faction.Enabled;
10895 Change;
10896 end;
10897
10898 procedure TKOLToolbarButton.SetimgIndex(const Value: Integer);
10899 begin
10900 if Fseparator then
10901 FimgIndex := -1
10902 else
10903 FimgIndex := Value;
10904 Change;
10905 end;
10906
10907 procedure TKOLToolbarButton.SetName(const NewName: TComponentName);
10908 var OldName, NewMethodName: String;
10909 F: TForm;
10910 D: IDesigner;
10911 FD: IFormDesigner;
10912 begin
10913 asm
10914 jmp @@e_signature
10915 DB '#$signature$#', 0
10916 DB 'TKOLToolbarButton.SetName', 0
10917 @@e_signature:
10918 end;
10919 OldName := Name;
10920 //Rpt( 'Renaming ' + OldName + ' to ' + NewName );
10921 if (FToolbar <> nil) and (OldName <> '') and
10922 (FToolbar.FindComponent( NewName ) <> nil) then
10923 begin
10924 ShowMessage( 'Can not rename to ' + NewName + ' - such name is already used.' );
10925 Exit;
10926 end;
10927 if (OldName <> '') and (NewName = '') then
10928 begin
10929 ShowMessage( 'Can not rename to '''' - name must not be empty.' );
10930 Exit;
10931 end;
10932 inherited;
10933 if OldName = '' then Exit;
10934 if fOnClickMethodName <> '' then
10935 if FToolbar <> nil then
10936 begin
10937 if LowerCase( FToolbar.Name + OldName + 'Click' ) = LowerCase( fOnClickMethodName ) then
10938 begin
10939 // rename event handler also here:
10940 F := FToolbar.ParentForm;
10941 NewMethodName := FToolbar.Name + NewName + 'Click';
10942 if F <> nil then
10943 begin
10944 {$IFDEF _D6orHigher}
10945 F.Designer.QueryInterface(IFormDesigner,D);
10946 {$ELSE}
10947 D := F.Designer;
10948 {$ENDIF}
10949 if D <> nil then
10950 if QueryFormDesigner( D, FD ) then
10951 begin
10952 if not FD.MethodExists( NewMethodName ) then
10953 begin
10954 FD.RenameMethod( fOnClickMethodName, NewMethodName );
10955 if FD.MethodExists( NewMethodName ) then
10956 fOnClickMethodName := NewMethodName;
10957 end;
10958 end;
10959 end;
10960 end;
10961 end;
10962 Change;
10963 end;
10964
10965 procedure TKOLToolbarButton.SetonClick(const Value: TOnToolbarButtonClick);
10966 var F: TForm;
10967 begin
10968 asm
10969 jmp @@e_signature
10970 DB '#$signature$#', 0
10971 DB 'TKOLToolbarButton.SetOnClick', 0
10972 @@e_signature:
10973 end;
10974 if @ fOnClick = @ Value then Exit;
10975 FonClick := Value;
10976 if TMethod( Value ).Code <> nil then
10977 begin
10978 if FToolbar <> nil then
10979 begin
10980 F := FToolbar.ParentForm;
10981 fOnClickMethodName := F.MethodName( TMethod( Value ).Code );
10982 end;
10983 end
10984 else
10985 FOnClickMethodName := '';
10986 Change;
10987 end;
10988
10989 procedure TKOLToolbarButton.Setpicture(Value: TPicture);
10990 var Bmp: TBitmap;
10991 I: Integer;
10992 begin
10993 asm
10994 jmp @@e_signature
10995 DB '#$signature$#', 0
10996 DB 'TKOLToolbarButton.Setpicture', 0
10997 @@e_signature:
10998 end;
10999 if Value <> nil then
11000 if Value.Width * Value.Height = 0 then
11001 Value := nil;
11002 if Value = nil then
11003 begin
11004 Fpicture.Free;
11005 Fpicture := TPicture.Create;
11006 end
11007 else
11008 begin
11009 if FToolbar.ImageListsUsed then
11010 begin
11011 I := MessageBox( Application.Handle, 'Image list(s) will be detached from the toolbar.'#13#10 +
11012 'Continue?', PChar( Application.Title + ' : ' + Name ), MB_OKCANCEL );
11013 if I <> ID_OK then Exit;
11014 FToolbar.imageListNormal := nil;
11015 FToolbar.imageListDisabled := nil;
11016 FToolbar.imageListHot := nil;
11017 end;
11018 Bmp := TBitmap.Create;
11019 TRY
11020 Bmp.Width := Value.Width;
11021 Bmp.Height := Value.Height;
11022 if Value.Graphic is TIcon then
11023 begin
11024 Bmp.Canvas.Brush.Color := clSilver;
11025 Bmp.Canvas.FillRect( Rect( 0, 0, Bmp.Width, Bmp.Height ) );
11026 Bmp.Canvas.Draw( 0, 0, Value.Graphic );
11027 end
11028 else
11029 Bmp.Assign( Value.Graphic );
11030 Fpicture.Assign( Bmp );
11031 FINALLY
11032 Bmp.Free;
11033 END;
11034 Fseparator := False;
11035 end;
11036 FToolbar.AssembleBitmap;
11037 if Assigned(FToolbar.FKOLCtrl) then
11038 FToolbar.RecreateWnd;
11039 Change;
11040 end;
11041
11042 procedure TKOLToolbarButton.SetradioGroup(const Value: Integer);
11043 var I, J: Integer;
11044 AlreadyPresent, TheSameBefore, TheSameAfter: Boolean;
11045 Bt: TKOLToolbarButton;
11046 begin
11047 if Value = FradioGroup then Exit;
11048 I := FToolbar.Items.IndexOf( Self );
11049 if I < 0 then Exit;
11050 if Value <> 0 then
11051 begin
11052 AlreadyPresent := FALSE;
11053 for J := 0 to FToolbar.Items.Count-1 do
11054 begin
11055 if I = J then continue;
11056 Bt := FToolbar.Items[ J ];
11057 if Bt.FradioGroup = Value then
11058 begin
11059 AlreadyPresent := TRUE;
11060 break;
11061 end;
11062 end;
11063 if AlreadyPresent then
11064 begin
11065 TheSameBefore := FALSE;
11066 TheSameAfter := FALSE;
11067 if (I > 0) then
11068 begin
11069 Bt := FToolbar.Items[ I - 1 ];
11070 if not Bt.separator and (Bt.FradioGroup = Value) then
11071 TheSameBefore := TRUE;
11072 end;
11073 if (I < FToolbar.Items.Count-1) then
11074 begin
11075 Bt := FToolbar.Items[ I + 1 ];
11076 if not Bt.separator and (Bt.FradioGroup = Value) then
11077 TheSameAfter := TRUE;
11078 end;
11079 if not (TheSameBefore or TheSameAfter) then Exit;
11080 end;
11081 end;
11082 FradioGroup := Value;
11083 Change;
11084 end;
11085
11086 procedure TKOLToolbarButton.Setseparator(const Value: Boolean);
11087 begin
11088 asm
11089 jmp @@e_signature
11090 DB '#$signature$#', 0
11091 DB 'TKOLToolbarButton.Setseparator', 0
11092 @@e_signature:
11093 end;
11094 if Fseparator = Value then Exit;
11095 Fseparator := Value;
11096 if Value then
11097 begin
11098 Fcaption := '-';
11099 FimgIndex := -1;
11100 end;
11101 Change;
11102 end;
11103
11104 procedure TKOLToolbarButton.Setsysimg(const Value: TSystemToolbarImage);
11105 var I: Integer;
11106 begin
11107 if Value <> stiCustom then
11108 begin
11109 if (FToolbar.ImageListNormal <> nil) or
11110 (FToolbar.ImageListDisabled <> nil) or
11111 (FToolbar.ImageListHot <> nil) then
11112 begin
11113 I := MessageBox( Application.Handle, 'Image list(s) will be detached from ' +
11114 'the toolbar. Continue?', PChar( Application.Title + ' : ' + Name ),
11115 MB_OKCANCEL );
11116 if I <> ID_OK then Exit;
11117 FToolbar.ImageListNormal := nil;
11118 FToolbar.ImageListDisabled := nil;
11119 FToolbar.ImageListHot := nil;
11120 end;
11121 picture := nil;
11122 end;
11123 Fsysimg := Value;
11124 if Assigned(FToolbar.FKOLCtrl) then
11125 FToolbar.RecreateWnd;
11126 Change;
11127 end;
11128
11129 procedure TKOLToolbarButton.Settooltip(const Value: String);
11130 begin
11131 asm
11132 jmp @@e_signature
11133 DB '#$signature$#', 0
11134 DB 'TKOLToolbarButton.Settooltip', 0
11135 @@e_signature:
11136 end;
11137 if Ftooltip = Value then Exit;
11138 if Faction = nil then
11139 Ftooltip := Value
11140 else
11141 Ftooltip:=Faction.Hint;
11142 if FToolbar <> nil then
11143 FToolbar.AssembleTooltips;
11144 Change;
11145 end;
11146
11147 procedure TKOLToolbarButton.Setvisible(const Value: Boolean);
11148 begin
11149 asm
11150 jmp @@e_signature
11151 DB '#$signature$#', 0
11152 DB 'TKOLToolbarButton.Setvisible', 0
11153 @@e_signature:
11154 end;
11155 if Fvisible = Value then Exit;
11156 if Faction = nil then
11157 Fvisible := Value
11158 else
11159 Fvisible:=Faction.Visible;
11160 Change;
11161 end;
11162
11163 { TKOLToolButtonOnClickPropEditor }
11164
11165 function TKOLToolButtonOnClickPropEditor.GetValue: string;
11166 var Comp: TPersistent;
11167 F: TForm;
11168 D: IDesigner;
11169 FD: IFormDesigner;
11170 Orig: String;
11171 begin
11172 asm
11173 jmp @@e_signature
11174 DB '#$signature$#', 0
11175 DB 'TKOLToolbarButtonOnClickPropEditor.GetValue', 0
11176 @@e_signature:
11177 end;
11178 if FResetting then
11179 begin
11180 Result := '';
11181 Exit;
11182 end;
11183 Result := inherited GetValue;
11184 Orig := Result;
11185 //**Windows.Beep( 100, 100 );
11186 if Result = '' then
11187 begin
11188 Comp := GetComponent( 0 );
11189 if Comp <> nil then
11190 if Comp is TKOLToolbarButton then
11191 begin
11192 Result := (Comp as TKOLToolbarButton).FOnClickMethodName;
11193 end;
11194 end;
11195 //**Windows.Beep( 200, 100 );
11196 TRY
11197
11198 Comp := GetComponent( 0 );
11199 if (Comp <> nil) and
11200 (Comp is TKOLToolbarButton) and
11201 ((Comp as TKOLToolbarButton).FToolbar <> nil) then
11202 begin
11203 F := (Comp as TKOLToolbarButton).FToolbar.ParentForm;
11204 if (F = nil) or (F.Designer = nil) then
11205 begin
11206 Result := ''; Exit;
11207 end;
11208 {$IFDEF _D6orHigher}
11209 F.Designer.QueryInterface(IFormDesigner,D);
11210 {$ELSE}
11211 D := F.Designer;
11212 {$ENDIF}
11213 if (D <> nil) and QueryFormDesigner( D, FD ) then
11214 begin
11215 if not FD.MethodExists( Result ) then Result := '';
11216 end
11217 else Result := '';
11218 end
11219 else Result := '';
11220 //**Windows.Beep( 200, 100 );
11221 if (Result = '') and (Orig <> '') then
11222 begin
11223 FResetting := TRUE;
11224 TRY
11225 //Windows.Beep( 100, 200 );
11226 SetValue( '' );
11227 FINALLY
11228 FResetting := FALSE;
11229 END;
11230 end;
11231
11232 EXCEPT
11233 Rpt( 'Exception while retrieving property onClick for TKOLToolbarButton' );
11234 END;
11235 end;
11236
11237 procedure TKOLToolButtonOnClickPropEditor.SetValue(const AValue: string);
11238 var Comp: TPersistent;
11239 I: Integer;
11240 begin
11241 asm
11242 jmp @@e_signature
11243 DB '#$signature$#', 0
11244 DB 'TKOLToolbarButtonOnClickPropEditor.SetValue', 0
11245 @@e_signature:
11246 end;
11247 inherited;
11248 for I := 0 to PropCount - 1 do
11249 begin
11250 Comp := GetComponent( I );
11251 if Comp <> nil then
11252 if Comp is TKOLToolbarButton then
11253 begin
11254 (Comp as TKOLToolbarButton).FOnClickMethodName := AValue;
11255 (Comp as TKOLToolbarButton).Change;
11256 end;
11257 end;
11258 end;
11259
11260 { TKOLListViewColumn }
11261
11262 procedure TKOLListViewColumn.Change;
11263 begin
11264 if Assigned( FListView ) then begin
11265 FListView.UpdateColumns; {YS}
11266 FListView.Change;
11267 end;
11268 end;
11269
11270 constructor TKOLListViewColumn.Create(AOwner: TComponent);
11271 begin
11272 inherited;
11273 FLVColOrder := -1;
11274 FLVColImage := -1;
11275 if AOwner <> nil then
11276 if AOwner is TKOLListView then
11277 begin
11278 FListView := AOwner as TKOLListView;
11279 FListView.Cols.Add( Self );
11280 {ShowMessage( 'Parent FListView=' + Int2Hex( DWORD( FListView ), 8 ) + ', ' +
11281 FListView.Name );}
11282 end;
11283 FWidth := 50;
11284 end;
11285
11286 procedure TKOLListViewColumn.DefProps(const Prefix: String; Filer: TFiler);
11287 begin
11288 Filer.DefineProperty( Prefix + 'Name', LoadName, SaveName, True );
11289 Filer.DefineProperty( Prefix + 'Caption', LoadCaption, SaveCaption, True );
11290 Filer.DefineProperty( Prefix + 'TextAlign', LoadTextAlign, SaveTextAlign, True );
11291 Filer.DefineProperty( Prefix + 'Width', LoadWidth, SaveWidth, True );
11292 Filer.DefineProperty( Prefix + 'WidthType', LoadWidthType, SaveWidthType, True );
11293 Filer.DefineProperty( Prefix + 'LVColImage', LoadLVColImage, SaveLVColImage, True );
11294 Filer.DefineProperty( Prefix + 'LVColOrder', LoadLVColOrder, SaveLVColOrder, LVColOrder >= 0 );
11295 Filer.DefineProperty( Prefix + 'LVColRightImg', LoadLVColRightImg, SaveLVColRightImg, LVColRightImg );
11296 end;
11297
11298 destructor TKOLListViewColumn.Destroy;
11299 begin
11300 if FListView <> nil then
11301 begin
11302 FListView.FCols.Remove( Self );
11303 FListView.UpdateColumns;
11304 FListView.Change;
11305 end;
11306 inherited;
11307 end;
11308
11309 procedure TKOLListViewColumn.LoadCaption(Reader: TReader);
11310 begin
11311 fCaption := Reader.ReadString;
11312 end;
11313
11314 procedure TKOLListViewColumn.LoadLVColImage(Reader: TReader);
11315 begin
11316 FLVColImage := Reader.ReadInteger;
11317 end;
11318
11319 procedure TKOLListViewColumn.LoadLVColOrder(Reader: TReader);
11320 begin
11321 LVColOrder := Reader.ReadInteger;
11322 end;
11323
11324 procedure TKOLListViewColumn.LoadLVColRightImg(Reader: TReader);
11325 begin
11326 FLVColRightImg := Reader.ReadBoolean;
11327 end;
11328
11329 procedure TKOLListViewColumn.LoadName(Reader: TReader);
11330 begin
11331 Name := Reader.ReadString;
11332 end;
11333
11334 procedure TKOLListViewColumn.LoadTextAlign(Reader: TReader);
11335 begin
11336 FTextAlign := TTextAlign( Reader.ReadInteger );
11337 end;
11338
11339 procedure TKOLListViewColumn.LoadWidth(Reader: TReader);
11340 begin
11341 FWidth := Reader.ReadInteger;
11342 end;
11343
11344 procedure TKOLListViewColumn.LoadWidthType(Reader: TReader);
11345 begin
11346 FWidthType := TKOLListViewColWidthType( Reader.ReadInteger );
11347 end;
11348
11349 procedure TKOLListViewColumn.SaveCaption(Writer: TWriter);
11350 begin
11351 Writer.WriteString( fCaption );
11352 end;
11353
11354 procedure TKOLListViewColumn.SaveLVColImage(Writer: TWriter);
11355 begin
11356 Writer.WriteInteger( FLVColImage );
11357 end;
11358
11359 procedure TKOLListViewColumn.SaveLVColOrder(Writer: TWriter);
11360 begin
11361 Writer.WriteInteger( FLVColOrder );
11362 end;
11363
11364 procedure TKOLListViewColumn.SaveLVColRightImg(Writer: TWriter);
11365 begin
11366 Writer.WriteBoolean( FLVColRightImg );
11367 end;
11368
11369 procedure TKOLListViewColumn.SaveName(Writer: TWriter);
11370 begin
11371 Writer.WriteString( Name );
11372 end;
11373
11374 procedure TKOLListViewColumn.SaveTextAlign(Writer: TWriter);
11375 begin
11376 Writer.WriteInteger( Integer( FTextAlign ) );
11377 end;
11378
11379 procedure TKOLListViewColumn.SaveWidth(Writer: TWriter);
11380 begin
11381 Writer.WriteInteger( FWidth );
11382 end;
11383
11384 procedure TKOLListViewColumn.SaveWidthType(Writer: TWriter);
11385 begin
11386 Writer.WriteInteger( Integer( FWidthType ) );
11387 end;
11388
11389 procedure TKOLListViewColumn.SetCaption(const Value: String);
11390 begin
11391 FCaption := Value;
11392 Change;
11393 end;
11394
11395 procedure TKOLListViewColumn.SetLVColImage(const Value: Integer);
11396 begin
11397 FLVColImage := Value;
11398 Change;
11399 end;
11400
11401 procedure TKOLListViewColumn.SetLVColOrder(const Value: Integer);
11402 var I: Integer;
11403 Col: TKOLListViewColumn;
11404 begin
11405 if FListView <> nil then
11406 begin
11407 for I := 0 to FListView.Cols.Count-1 do
11408 begin
11409 Col := FListView.Cols[ I ];
11410 if Col = Self then continue;
11411 if Col.FLVColOrder > FLVColOrder then
11412 Dec( Col.FLVColOrder );
11413 end;
11414 if Value >= 0 then
11415 for I := 0 to FListView.Cols.Count-1 do
11416 begin
11417 Col := FListView.Cols[ I ];
11418 if Col = Self then continue;
11419 if Col.FLVColOrder >= Value then
11420 Inc( Col.FLVColOrder );
11421 end;
11422 end;
11423 FLVColOrder := Value;
11424 Change;
11425 end;
11426
11427 procedure TKOLListViewColumn.SetLVColRightImg(const Value: Boolean);
11428 begin
11429 FLVColRightImg := Value;
11430 Change;
11431 end;
11432
11433 procedure TKOLListViewColumn.SetName(const AName: TComponentName);
11434 begin
11435 inherited;
11436 Change;
11437 end;
11438
11439 procedure TKOLListViewColumn.SetTextAlign(const Value: TTextAlign);
11440 begin
11441 FTextAlign := Value;
11442 Change;
11443 end;
11444
11445 procedure TKOLListViewColumn.SetWidth(const Value: Integer);
11446 begin
11447 FWidth := Value;
11448 Change;
11449 end;
11450
11451 procedure TKOLListViewColumn.SetWidthType(
11452 const Value: TKOLListViewColWidthType);
11453 begin
11454 FWidthType := Value;
11455 Change;
11456 end;
11457
11458 { TKOLLVColumnsPropEditor }
11459
11460 procedure TKOLLVColumnsPropEditor.Edit;
11461 var LV: TKOLListView;
11462 begin
11463 if GetComponent( 0 ) = nil then Exit;
11464 LV := GetComponent( 0 ) as TKOLListView;
11465 if LV.ActiveDesign = nil then
11466 LV.ActiveDesign := TfmLVColumnsEditor.Create( Application );
11467 LV.ActiveDesign.ListView := LV;
11468 LV.ActiveDesign.Visible := TRUE;
11469 SetForegroundWindow( LV.ActiveDesign.Handle );
11470 LV.ActiveDesign.MakeActive( TRUE );
11471 if LV.ParentForm <> nil then
11472 LV.ParentForm.Invalidate;
11473 end;
11474
11475 function TKOLLVColumnsPropEditor.GetAttributes: TPropertyAttributes;
11476 begin
11477 Result := [ paDialog, paReadOnly ];
11478 end;
11479
11480 { TKOLLVColumnsEditor }
11481
11482 procedure TKOLLVColumnsEditor.Edit;
11483 var LV: TKOLListView;
11484 begin
11485 if Component = nil then Exit;
11486 if not(Component is TKOLListView) then Exit;
11487 LV := Component as TKOLListView;
11488 if LV.ActiveDesign = nil then
11489 LV.ActiveDesign := TfmLVColumnsEditor.Create( Application );
11490 LV.ActiveDesign.ListView := LV;
11491 LV.ActiveDesign.Visible := True;
11492 SetForegroundWindow( LV.ActiveDesign.Handle );
11493 LV.ActiveDesign.MakeActive( TRUE );
11494 if LV.ParentForm <> nil then
11495 LV.ParentForm.Invalidate;
11496 end;
11497
11498 procedure TKOLLVColumnsEditor.ExecuteVerb(Index: Integer);
11499 begin
11500 Edit;
11501 end;
11502
11503 function TKOLLVColumnsEditor.GetVerb(Index: Integer): string;
11504 begin
11505 Result := '&Edit columns';
11506 end;
11507
11508 function TKOLLVColumnsEditor.GetVerbCount: Integer;
11509 begin
11510 Result := 1;
11511 end;
11512
11513 { TKOLDateTimePicker }
11514
11515 procedure TKOLDateTimePicker.AssignEvents(SL: TStringList;
11516 const AName: String);
11517 begin
11518 inherited;
11519 DoAssignEvents( SL, AName, [ 'OnDTPUserString' ], [ @ OnDTPUserString ] );
11520 end;
11521
11522 constructor TKOLDateTimePicker.Create(AOwner: TComponent);
11523 begin
11524 inherited;
11525 Width := 110; DefaultWidth := Width;
11526 Height := 24; DefaultHeight := Height;
11527 Color := clWindow;
11528 fTabStop := TRUE;
11529 end;
11530
11531 function TKOLDateTimePicker.GenerateTransparentInits: String;
11532 begin
11533 Result := inherited GenerateTransparentInits;
11534 end;
11535
11536 procedure TKOLDateTimePicker.SetFormat(const Value: String);
11537 begin
11538 FFormat := Value;
11539 Change;
11540 end;
11541
11542 procedure TKOLDateTimePicker.SetOnDTPUserString(
11543 const Value: TDTParseInputEvent);
11544 begin
11545 FOnDTPUserString := Value;
11546 Change;
11547 end;
11548
11549 procedure TKOLDateTimePicker.SetOptions(
11550 const Value: TDateTimePickerOptions);
11551 begin
11552 if ( dtpoTime in Value ) and not( dtpoTime in FOptions ) then
11553 FOptions := Value + [ dtpoUpDown ]
11554 else
11555 FOptions := Value;
11556 Change;
11557 end;
11558
11559 procedure TKOLDateTimePicker.SetupFirst(SL: TStringList; const AName,
11560 AParent, Prefix: String);
11561 begin
11562 inherited;
11563 if Format <> '' then
11564 SL.Add( Prefix + AName + '.DateTimeFormat := ' +
11565 StringConstant( 'Format', Format ) + ';' );
11566 if not ParentColor then
11567 SL.Add( Prefix + AName + '.DateTimePickerColors[ dtpcBackground ] := ' +
11568 Color2Str( Color ) + ';' );
11569 end;
11570
11571 function TKOLDateTimePicker.SetupParams(const AName,
11572 AParent: String): String;
11573 var S: String;
11574 begin
11575 S := '';
11576 if dtpoTime in Options then S := S + ',dtpoTime';
11577 if dtpoDateLong in Options then S := S + ',dtpoDateLong';
11578 if dtpoUpDown in Options then S := S + ',dtpoUpDown';
11579 if dtpoRightAlign in Options then S := S + ',dtpoRightAlign';
11580 if dtpoShowNone in Options then S := S + ',dtpoShowNone';
11581 if dtpoParseInput in Options then S := S + ',dtpoParseInput';
11582 Delete( S, 1, 1 );
11583 Result := AParent + ', [' + S + ']';
11584 end;
11585
11586 function TKOLDateTimePicker.TabStopByDefault: Boolean;
11587 begin
11588 Result := TRUE;
11589 end;
11590
11591 end.
11592
11593
11594