mirror.pas.200to208-000.old

   1 {******************************************************\r
   2 \r
   3         KKKKK    KKKKK    OOOOOOOOO    LLLLL\r
   4         KKKKK    KKKKK  OOOOOOOOOOOOO  LLLLL\r
   5         KKKKK    KKKKK  OOOOO   OOOOO  LLLLL\r
   6         KKKKK  KKKKK    OOOOO   OOOOO  LLLLL\r
   7         KKKKKKKKKK      OOOOO   OOOOO  LLLLL\r
   8         KKKKK  KKKKK    OOOOO   OOOOO  LLLLL\r
   9         KKKKK    KKKKK  OOOOO   OOOOO  LLLLL\r
  10         KKKKK    KKKKK  OOOOOOOOOOOOO  LLLLLLLLLLLLL     kkkkk\r
  11         KKKKK    KKKKK    OOOOOOOOO    LLLLLLLLLLLLL    kkkkk\r
  12                                                        kkkkk\r
  13     mmmmm  mmmmm   mmmmmm          cccccccccccc       kkkkk   kkkkk\r
  14    mmmmmmmm   mmmmm     mmmmm   cccccc       ccccc   kkkkk kkkkk\r
  15   mmmmmmmm   mmmmm     mmmmm   cccccc               kkkkkkkk\r
  16  mmmmm      mmmmm     mmmmm   cccccc      ccccc    kkkkk  kkkkk\r
  17 mmmmm      mmmmm     mmmmm     cccccccccccc       kkkkk     kkkkk\r
  18 \r
  19   Key Objects Library (C) 2000 by Kladov Vladimir.\r
  20   KOL Mirror Classes Kit (C) 2000 by Kladov Vladimir.\r
  21 ********************************************************\r
  22 * VERSION 2.00\r
  23 ********************************************************\r
  24 }\r
  25 unit mirror;\r
  26 {\r
  27   This unit contains definitions of mirror classes reflecting to objects of\r
  28   KOL. Aim is to create kit for programming in KOL visually. Idea is not of main.\r
  29   Many people told me that they want to have such tool kit, and suggested\r
  30   different ways to implement it. But this implementation is made by me,\r
  31   and I reserve all rights for code below, containing my own (original, I\r
  32   hope) solutions, and for all accompanied files distributed together in\r
  33   KOL Mirror Classes Kit. While I am writing this, I have not yet clearance\r
  34   in all problems, which I can meet on such way, but... let God tell me the\r
  35   right direction.\r
  36                   by Vladimir Kladov, 27.11.2000\r
  37 \r
  38   Â äàííîì ìîäóëå îïðåäåëÿþòñÿ çåðêàëüíûå êëàññû äëÿ îáúåêòîâ áèáëèîòåêè KOL.\r
  39   Öåëü - ñîçäàòü ñðåäñòâî äëÿ âèçóàëüíîãî ïðîåêòèðîâàíèÿ ïðîåêòîâ KOL.\r
  40   Èäåÿ íå ìîÿ. Ïîñòóïèëà êî ìíå îò ðàçëè÷íûõ ëþäåé â ðàçëè÷íîå âðåìÿ.\r
  41   Íî åé òðåáîâàëîñü äîçðåòü. Êîãäà ÿ ýòó ïèøó, ìíå åùå íå î÷åíü ÿñíî, êàê\r
  42   áóäóò ðåøàòüñÿ ïðîáëåìû, êîòîðûå âñòðåòÿòñÿ, íî... ïóñòü Áîã ïîäñêàæåò\r
  43   ïðàâèëüíûé ïóòü.\r
  44                   Êëàäîâ Âëàäèìèð, 27.11.2000.\r
  45 }\r
  46 \r
  47 interface\r
  48 \r
  49 {$I KOLDEF.INC}\r
  50 \r
  51 uses olectrls, KOL, Classes, Forms, Controls, Dialogs, Windows, Messages, extctrls,\r
  52      stdctrls, comctrls, SysUtils, Graphics,\r
  53 //////////////////////////////////////////////////\r
  54      ExptIntf, ToolIntf, EditIntf, // DsgnIntf\r
  55 //////////////////////////////////////////////////\r
  56      {$IFDEF _D6orHigher}                       //\r
  57      DesignIntf, DesignEditors, DesignConst,    //\r
  58      Variants                                   //\r
  59      {$ELSE}                                    //\r
  60      DsgnIntf                                   //\r
  61      {$ENDIF}                                   //\r
  62 //////////////////////////////////////////////////\r
  63      {$IFNDEF _D2}{$IFNDEF _D3}, ToolsAPI{$ENDIF}{$ENDIF},\r
  64      TypInfo, Consts,\r
  65      mckMenuEditor, mckAccEditor, mckActionListEditor;\r
  66 \r
  67 {$IFDEF _D4}\r
  68 {$O-}\r
  69 {$ENDIF}\r
  70 \r
  71 {$IFDEF _D2}\r
  72 type TCustomForm = TForm;\r
  73 {$ENDIF}\r
  74 \r
  75 const\r
  76   WM_USER_ALIGNCHILDREN = WM_USER + 1;\r
  77   cKOLTag = -999;\r
  78 \r
  79 type\r
  80 \r
  81 \r
  82 //////////////////////////////////////////////////////////\r
  83      {$IFDEF _D6orHigher}                               //\r
  84       TDesignerSelectionList = TDesignerSelections;     //\r
  85      {$ENDIF}                                           //\r
  86 //////////////////////////////////////////////////////////\r
  87 \r
  88 \r
  89 \r
  90 \r
  91 \r
  92 \r
  93 \r
  94 \r
  95 \r
  96 \r
  97 \r
  98 \r
  99 \r
 100 \r
 101 \r
 102 \r
 103   TKOLActionList = class;\r
 104   TKOLAction = class;\r
 105 \r
 106 \r
 107 \r
 108   TPaintType = ( ptWYSIWIG, ptWYSIWIGFrames, ptSchematic, ptWYSIWIGCustom ); {YS}\r
 109 \r
 110   //============================================================================\r
 111   // TKOLProject component corresponds to the KOL project. It must be present\r
 112   // once in a project. It is responding for code generation and contains\r
 113   // properties available from Object Inspector, common for entire project\r
 114   // (used for maintainig project and in generating of code).\r
 115   //\r
 116   // Ïðîåêòó KOL ñîîòâåòñòâóåò êîìïîíåíò TKOLProject (äîëæåí ïðèñóòñòâîâàòü\r
 117   // îäèí ðàç â ïðîåêòå). Îí îòâå÷àåò çà ãåíåðàöèþ êîäà è ñîäåðæèò äîñòóïíûå\r
 118   // èç ObjectInspector-à íàñòðîéêè (îáùèå äëÿ âñåãî ïðîåêòà), èñïîëüçóåìûå\r
 119   // ïðè ãåíåðàöèè êîäà dpr-ôàéëà.\r
 120   TKOLProject = class( TComponent )\r
 121   private\r
 122     fProjectName: String;\r
 123     FProjectDest: String;\r
 124     fSourcePath: TFileName;\r
 125     fDprResource: Boolean;\r
 126     fProtect: Boolean;\r
 127     fShowReport: Boolean;\r
 128     fBuild: Boolean;\r
 129     fIsKOL: Integer;\r
 130     fOutdcuPath: String;\r
 131     fAutoBuild: Boolean;\r
 132     fTimer: TTimer;\r
 133     fAutoBuilding: Boolean;\r
 134     FAutoBuildDelay: Integer;\r
 135     fGettingSourcePath: Boolean;\r
 136     FConsoleOut: Boolean;\r
 137     FIn, FOut: THandle;\r
 138     FBuilding: Boolean;\r
 139     fChangingNow: Boolean;\r
 140     FSupportAnsiMnemonics: LCID;\r
 141     FPaintType: TPaintType;\r
 142     FHelpFile: String;\r
 143     FLocalizy: Boolean;\r
 144     FShowHint: Boolean;\r
 145     function GetProjectName: String;\r
 146     procedure SetProjectDest(const Value: String);\r
 147 \r
 148     function ConvertVCL2KOL( ConfirmOK: Boolean ): Boolean;\r
 149 \r
 150     function UpdateConfig: Boolean;\r
 151     function GetSourcePath: TFileName;\r
 152     function GetProjectDest: String;\r
 153     function GetBuild: Boolean;\r
 154     procedure SetBuild(const Value: Boolean);\r
 155     function GetIsKOLProject: Boolean;\r
 156     procedure SetIsKOLProject(const Value: Boolean);\r
 157     function GetOutdcuPath: TFileName;\r
 158     procedure SetOutdcuPath(const Value: TFileName);\r
 159     procedure SetAutoBuild(const Value: Boolean);\r
 160     function GetShowReport: Boolean;\r
 161     procedure SetAutoBuildDelay(const Value: Integer);\r
 162     procedure SetConsoleOut(const Value: Boolean);\r
 163     procedure SetLocked(const Value: Boolean);\r
 164     procedure SetSupportAnsiMnemonics(const Value: LCID);\r
 165     procedure SetPaintType(const Value: TPaintType);\r
 166     procedure SetHelpFile(const Value: String);\r
 167     procedure SetLocalizy(const Value: Boolean);\r
 168     procedure SetShowHint(const Value: Boolean);\r
 169   protected\r
 170     FLocked: Boolean;\r
 171     function GenerateDPR( const Path: String ): Boolean; virtual;\r
 172     procedure BeforeGenerateDPR( const SL: TStringList; var Updated: Boolean ); virtual;\r
 173     procedure AfterGenerateDPR( const SL: TStringList; var Updated: Boolean ); virtual;\r
 174     procedure TimerTick( Sender: TObject );\r
 175     property AutoBuilding: Boolean read fAutoBuilding write fAutoBuilding;\r
 176     procedure BroadCastPaintTypeToAllForms;\r
 177     procedure Loaded; override;\r
 178     procedure SetName(const NewName: TComponentName); override;\r
 179   protected\r
 180     ResStrings: TStringList;\r
 181     function StringConstant( const Propname, Value: String ): String;\r
 182     procedure MakeResourceString( const ResourceConstName, Value: String );\r
 183   public\r
 184     procedure Change;\r
 185     constructor Create( AOwner: TComponent ); override;\r
 186     destructor Destroy; override;\r
 187 \r
 188     procedure Report( const Txt: String );\r
 189     property Building: Boolean read FBuilding;\r
 190   published\r
 191     property Locked: Boolean read FLocked write SetLocked;\r
 192 \r
 193     property Localizy: Boolean read FLocalizy write SetLocalizy;\r
 194 \r
 195     // Name of source, i.e. mirror project. Detected by reading text of\r
 196     // Delphi IDE window. Can be corrected in Object Inspector.\r
 197     //\r
 198     // Èìÿ ïðîåêòà (çåðêàëüíîãî, ò.å. èñõîäíîãî). Îïðåäåëÿåòñÿ ïðîñòî - ïî\r
 199     // çàãîëîâêó îêíà Delphi IDE. Ìîæíî èçìåíèòü ðóêàìè.\r
 200     property projectName: String read GetProjectName write fProjectName;\r
 201 \r
 202     // Project name for converted (KOL) project. Must be entered manually,\r
 203     // and it must not much project name.\r
 204     // Èìÿ ïðîåêòà ïîñëå êîíâåðñèè â KOL. Òðåáóåòñÿ ââåñòè ðóêàìè.\r
 205     // Íè â êîåì ñëó÷àå íå äîëæåí ñîâïàäàòü ñ èìåíåì ñàìîãî ïðîåêòà.\r
 206     property projectDest: String read GetProjectDest write SetProjectDest;\r
 207 \r
 208     // Path to source (=mirror) project. When TKOLProject component is\r
 209     // dropped onto form, a dialog is appear to select path to a directory\r
 210     // with source files of the project. Resulting project is store in\r
 211     // \KOL subdirectory of the path. Path to a source is necessary to\r
 212     // generate KOL project on base of mirror one.\r
 213     //\r
 214     // Ïóòü ê èñõîäíîìó ïðîåêòó. Ïðè áðîñàíèè êîìïîíåíòà TKOLProject íà\r
 215     // ôîðìó âûâàëèâàåòñÿ äèàëîã ñ ïðåäëîæåíèåì óêàçàòü ïóòü ê èñõîäíîìó\r
 216     // ïðîåêòó. Ðåçóëüòèðóþùèé ïðîåêò (ïîñëå êîíâåðòàöèè â KOL) áóäåò ëåæàòü\r
 217     // â ïîääèðåêòîðèè \KOL èñõîäíîé ïàïêè. Áåç çíàíèÿ äàííîãî ïóòè çåðêàëà\r
 218     // ôîðì íå ñìîãóò íàéòè ñâîè èñõîäíûå ôàéëû.\r
 219     property sourcePath: TFileName read GetSourcePath write fSourcePath;\r
 220 \r
 221     property outdcuPath: TFileName read GetOutdcuPath write SetOutdcuPath;\r
 222 \r
 223     // True, if to include {$R *.RES} while generating dpr-file.\r
 224     // Èñòèíà, åñëè âêëþ÷àòü ðåñóðñ ïðîåêòà (èêîíêà 'MAINICON' â ôàéëå\r
 225     // èìÿ-ïðîåêòà.res).\r
 226     property dprResource: Boolean read fDprResource write fDprResource;\r
 227 \r
 228     // True, if all generated files to be marked Read-Only (by default,\r
 229     // since it is suggested to correct only source (=mirror) files.\r
 230     // === no more used ===\r
 231     //\r
 232     // Èñòèíà, åñëè äåëàòü ðåçóëüòèðóþùèå ôàéëû READ-ONLY (ïî óìîë÷àíèþ,\r
 233     // ò.ê. ïðåäïîëàãàåòñÿ, ÷òî ýòè ôàéëû íå íàäî ìîæèôèöèðîâàòü âðó÷íóþ)\r
 234     // === áîëåå íå èñïîëüçóåòñÿ ===\r
 235     property protectFiles: Boolean read fProtect write fProtect;\r
 236 \r
 237     property showReport: Boolean read GetShowReport write fShowReport;\r
 238 \r
 239     // True, if project is converted already to KOL. Since this,\r
 240     // it can be adjusted at design-time using visual capabilities\r
 241     // of Delphi IDE and when compiled only non-VCL features are\r
 242     // included into executable, so it is ten times smaller.\r
 243     property isKOLProject: Boolean read GetIsKOLProject write SetIsKOLProject;\r
 244 \r
 245     property autoBuild: Boolean read fAutoBuild write SetAutoBuild;\r
 246     property autoBuildDelay: Integer read FAutoBuildDelay write SetAutoBuildDelay;\r
 247     property BUILD: Boolean read GetBuild write SetBuild;\r
 248     property consoleOut: Boolean read FConsoleOut write SetConsoleOut;\r
 249 \r
 250     property SupportAnsiMnemonics: LCID read FSupportAnsiMnemonics write SetSupportAnsiMnemonics;\r
 251     {* Change this value to provide supporting of ANSI (localized) mnemonics.\r
 252        To have effect for a form, property SupportMnemonics should be set to\r
 253        TRUE for such form too. This value should be set to a number, correspondent\r
 254        to locale which is desired to be supported. Or, set it to value 1, to\r
 255        support default user locale of the system where the project is built.  }\r
 256 \r
 257     property PaintType: TPaintType read FPaintType write SetPaintType;\r
 258 \r
 259     property HelpFile: String read FHelpFile write SetHelpFile;\r
 260     property ShowHint: Boolean read FShowHint write SetShowHint;\r
 261     {* To provide tooltip (hint) showing, it is necessary to define conditional\r
 262        symbol USE_MHTOOLTIP in\r
 263        Project|Options|Directories/Conditionals|Conditional Defines. }\r
 264   end;\r
 265 \r
 266   TKOLProjectBuilder = class( TComponentEditor )\r
 267   private\r
 268   protected\r
 269   public\r
 270     procedure Edit; override;\r
 271     procedure ExecuteVerb(Index: Integer); override;\r
 272     function GetVerb(Index: Integer): string; override;\r
 273     function GetVerbCount: Integer; override;\r
 274   end;\r
 275 \r
 276 \r
 277 \r
 278 \r
 279 \r
 280 \r
 281 \r
 282 \r
 283 \r
 284 \r
 285 \r
 286 \r
 287 \r
 288 \r
 289 \r
 290 \r
 291 \r
 292 \r
 293 \r
 294 \r
 295 \r
 296 \r
 297 \r
 298 \r
 299 \r
 300   TKOLFont = class( TPersistent )\r
 301   private\r
 302     fOwner: TComponent;\r
 303     FFontCharset: Byte;\r
 304     FFontOrientation: Integer;\r
 305     FFontWidth: Integer;\r
 306     FFontHeight: Integer;\r
 307     FFontWeight: Integer;\r
 308     FFontName: String;\r
 309     FColor: TColor;\r
 310     FFontPitch: TFontPitch;\r
 311     FFontStyle: TFontStyles;\r
 312     fChangingNow: Boolean;\r
 313     procedure SetColor(const Value: TColor);\r
 314     procedure SetFontCharset(const Value: Byte);\r
 315     procedure SetFontHeight(const Value: Integer);\r
 316     procedure SetFontName(const Value: String);\r
 317     procedure SetFontOrientation(Value: Integer);\r
 318     procedure SetFontPitch(const Value: TFontPitch);\r
 319     procedure SetFontStyle(const Value: TFontStyles);\r
 320     procedure SetFontWeight(Value: Integer);\r
 321     procedure SetFontWidth(const Value: Integer);\r
 322   protected\r
 323     procedure Changing;\r
 324   public\r
 325     procedure Change;\r
 326     constructor Create( AOwner: TComponent );\r
 327     function Equal2( AFont: TKOLFont ): Boolean;\r
 328     procedure GenerateCode( SL: TStrings; const AName: String; AFont: TKOLFont );\r
 329     procedure Assign( Value: TPersistent ); override;\r
 330     property Owner: TComponent read fOwner;\r
 331   published\r
 332     property Color: TColor read FColor write SetColor;\r
 333     property FontStyle: TFontStyles read FFontStyle write SetFontStyle;\r
 334     property FontHeight: Integer read FFontHeight write SetFontHeight;\r
 335     property FontWidth: Integer read FFontWidth write SetFontWidth;\r
 336     property FontWeight: Integer read FFontWeight write SetFontWeight;\r
 337     property FontName: String read FFontName write SetFontName;\r
 338     property FontOrientation: Integer read FFontOrientation write SetFontOrientation;\r
 339     property FontCharset: Byte read FFontCharset write SetFontCharset;\r
 340     property FontPitch: TFontPitch read FFontPitch write SetFontPitch;\r
 341   end;\r
 342 \r
 343   TKOLBrush = class( TPersistent )\r
 344   private\r
 345     fOwner: TComponent;\r
 346     FBrushStyle: TBrushStyle;\r
 347     FColor: TColor;\r
 348     FBitmap: TBitmap;\r
 349     fChangingNow: Boolean;\r
 350     procedure SetBitmap(const Value: TBitmap);\r
 351     procedure SetBrushStyle(const Value: TBrushStyle);\r
 352     procedure SetColor(const Value: TColor);\r
 353   protected\r
 354     procedure GenerateCode( SL: TStrings; const AName: String );\r
 355   public\r
 356     procedure Change;\r
 357     constructor Create( AOwner: TComponent );\r
 358     destructor Destroy; override;\r
 359     procedure Assign( Value: TPersistent ); override;\r
 360   published\r
 361     property Color: TColor read FColor write SetColor;\r
 362     property BrushStyle: TBrushStyle read FBrushStyle write SetBrushStyle;\r
 363     property Bitmap: TBitmap read FBitmap write SetBitmap;\r
 364   end;\r
 365 \r
 366 \r
 367 \r
 368 \r
 369 \r
 370 \r
 371 \r
 372 \r
 373 \r
 374 \r
 375 \r
 376 \r
 377 \r
 378 \r
 379 \r
 380 \r
 381   //============================================================================\r
 382   // Mirror class, corresponding to unnecessary in KOL application\r
 383   // taskbar button (variable Applet).\r
 384   //\r
 385   // Çåðêàëüíûé êëàññ, ñîîòâåòñòâóþùèé íåîáÿçàòåëüíîìó â KOL\r
 386   // ïðèëîæåíèþ (îêíó, ïðåäñòàâëÿþùåìó êíîïêó ïðèëîæåíèÿ íà ïàíåëè\r
 387   // çàäà÷)\r
 388   TKOLApplet = class( TComponent )\r
 389   private\r
 390     FLastWarnTimeAbtMainForm: Integer;\r
 391     FShowingWarnAbtMainForm: Boolean;\r
 392     FOnMessage: TOnMessage;\r
 393     FOnDestroy: TOnEvent;\r
 394     FOnClose: TOnEventAccept;\r
 395     FIcon: String;\r
 396     fChangingNow: Boolean;\r
 397     FOnQueryEndSession: TOnEventAccept;\r
 398     FOnMinimize: TOnEvent;\r
 399     FOnRestore: TOnEvent;\r
 400     FAllBtnReturnClick: Boolean;\r
 401     FTag: Integer;\r
 402     FForceIcon16x16: Boolean;\r
 403     FTabulate: Boolean;\r
 404     FTabulateEx: Boolean;\r
 405     procedure SetCaption(const Value: String);\r
 406     procedure SetVisible(const Value: Boolean);\r
 407     procedure SetEnabled(const Value: Boolean);\r
 408     procedure SetOnMessage(const Value: TOnMessage);\r
 409     procedure SetOnDestroy(const Value: TOnEvent);\r
 410     procedure SetOnClose(const Value: TOnEventAccept);\r
 411     procedure SetIcon(const Value: String);\r
 412     procedure SetOnQueryEndSession(const Value: TOnEventAccept);\r
 413     procedure SetOnMinimize(const Value: TOnEvent);\r
 414     procedure SetOnRestore(const Value: TOnEvent);\r
 415     procedure SetAllBtnReturnClick(const Value: Boolean);\r
 416     procedure SetTag(const Value: Integer);\r
 417     procedure SetForceIcon16x16(const Value: Boolean);\r
 418     procedure SetTabulate(const Value: Boolean);\r
 419     procedure SetTabulateEx(const Value: Boolean);\r
 420   protected\r
 421     fCaption: String;\r
 422     fVisible, fEnabled: Boolean;\r
 423     FChanged: Boolean;\r
 424     fSourcePath: String;\r
 425     //Creating_DoNotGenerateCode: Boolean;\r
 426     procedure GenerateRun( SL: TStringList; const AName: String ); virtual;\r
 427     function AutoCaption: Boolean; virtual;\r
 428     procedure ChangeDPR; virtual;\r
 429 \r
 430     // Method to assign values to assigned events. Is called in SetupFirst\r
 431     // and actually should call DoAssignEvents, passing a list of (additional)\r
 432     // events to it.\r
 433     //\r
 434     // Ïðîöåäóðà ïðèñâàèâàíèÿ çíà÷åíèé íàçíà÷åííûì ñîáûòèÿì. Âûçûâàåòñÿ èç\r
 435     // SetupFirst è ôàêòè÷åñêè äîëæíà (ïîñëå âûçîâà inherited) ïåðåäàòü\r
 436     // â ïðîöåäóðó DoAssignEvents ñïèñîê (äîïîëíèòåëüíûõ) ñîáûòèé.\r
 437     procedure AssignEvents( SL: TStringList; const AName: String ); virtual;\r
 438 \r
 439     procedure DoAssignEvents( SL: TStringList; const AName: String;\r
 440               EventNames: array of PChar; EventHandlers: array of Pointer );\r
 441 \r
 442     function BestEventName: String; virtual;\r
 443   public\r
 444     procedure Change( Sender: TComponent ); virtual;\r
 445     constructor Create( AOwner: TComponent ); override;\r
 446     destructor Destroy; override;\r
 447     property Enabled: Boolean read fEnabled write SetEnabled;\r
 448   published\r
 449     property Icon: String read FIcon write SetIcon;\r
 450     property ForceIcon16x16: Boolean read FForceIcon16x16 write SetForceIcon16x16;\r
 451     property Caption: String read fCaption write SetCaption;\r
 452     property Visible: Boolean read fVisible write SetVisible;\r
 453     property OnMessage: TOnMessage read FOnMessage write SetOnMessage;\r
 454     property OnDestroy: TOnEvent read FOnDestroy write SetOnDestroy;\r
 455     property OnClose: TOnEventAccept read FOnClose write SetOnClose;\r
 456     property OnQueryEndSession: TOnEventAccept read FOnQueryEndSession write SetOnQueryEndSession;\r
 457     property OnMinimize: TOnEvent read FOnMinimize write SetOnMinimize;\r
 458     property OnRestore: TOnEvent read FOnRestore write SetOnRestore;\r
 459     property AllBtnReturnClick: Boolean read FAllBtnReturnClick write SetAllBtnReturnClick;\r
 460     property Tag: Integer read FTag write SetTag;\r
 461     property Tabulate: Boolean read FTabulate write SetTabulate;\r
 462     property TabulateEx: Boolean read FTabulateEx write SetTabulateEx;\r
 463     property UnitSourcePath: String read fSourcePath write fSourcePath;\r
 464   end;\r
 465 \r
 466   // Special class to avoid conflict with Left and Top properties of\r
 467   // component in VCL and component TKOLForm correspondent properties.\r
 468   //\r
 469   // Ñïåöèàëüíûé êëàññ, ÷òîáû îáîéòè êîíôëèêò ñî ñâîéñòâàìè Left / Top\r
 470   // â Bounds ôîðìû (â êîìïîíåíòå TKOLForm).\r
 471   TFormBounds = class( TPersistent )\r
 472   private\r
 473     fOwner: TComponent;\r
 474     fTimer: TTimer;\r
 475     fL, fT, fW, fH: Integer;\r
 476     function GetHeight: Integer;\r
 477     function GetLeft: Integer;\r
 478     function GetTop: Integer;\r
 479     function GetWidth: Integer;\r
 480     procedure SetHeight(const Value: Integer);\r
 481     procedure SetLeft(const Value: Integer);\r
 482     procedure SetTop(const Value: Integer);\r
 483     procedure SetWidth(const Value: Integer);\r
 484     procedure CheckFormSize( Sender: TObject );\r
 485     procedure SetOwner(const Value: TComponent);\r
 486   protected\r
 487   public\r
 488     procedure Change;\r
 489     constructor Create;\r
 490     destructor Destroy; override;\r
 491     property Owner: TComponent read fOwner write SetOwner;\r
 492     procedure EnableTimer(Value: Boolean);\r
 493   published\r
 494     property Left: Integer read GetLeft write SetLeft stored False;\r
 495     property Top: Integer read GetTop write SetTop stored False;\r
 496     property Width: Integer read GetWidth write SetWidth stored False;\r
 497     property Height: Integer read GetHeight write SetHeight stored False;\r
 498   end;\r
 499 \r
 500 \r
 501 \r
 502 \r
 503 \r
 504 \r
 505 \r
 506 \r
 507 \r
 508 \r
 509 \r
 510 \r
 511 \r
 512 \r
 513 \r
 514 \r
 515 \r
 516 \r
 517 \r
 518 \r
 519 \r
 520 \r
 521 \r
 522 \r
 523 \r
 524 \r
 525   //============================================================================\r
 526   // Mirror component, corresponding to KOL's form. It must be present\r
 527   // on each of mirror project's form to provide generating of corresponding\r
 528   // unit in resulting KOL project.\r
 529   //\r
 530   // Ôîðìå èç KOL ñîîòâåòñòâóåò çåðêàëüíûé êîìïîíåíò TKOLForm. Îí äîëæåí\r
 531   // ïðèñóòñòâîâàòü íà ôîðìå çåðêàëüíîãî ïðîåêòà äëÿ òîãî, ÷òîáû ïðè çàïóñêå\r
 532   // åãî ñãåíåðèðîâàëñÿ êîä ñîîòâåòñòâóþùåãî ìîäóëÿ äëÿ êîìïèëÿöèè ñ\r
 533   // èñïîëüçîâàíèåì KOL. Êðîìå òîãî, ìîäèôèöèðóÿ åãî ñâîéñòâà â Èíñïåêòîðå,\r
 534   // âîçìîæíî íàñòðîèòü ñâîéñòâà ôîðìû KOL "âèçóàëüíî".\r
 535   TKOLCustomControl = class;\r
 536   TKOLPopupMenu = class;\r
 537 \r
 538   TLocalizyOptions = ( loForm, loNo, loYes  );\r
 539 \r
 540   TKOLFormBorderStyle = ( fbsNone, fbsSingle, fbsDialog, fbsToolWindow );  {YS}\r
 541 \r
 542   TKOLForm = class( TKOLApplet )\r
 543   private\r
 544     fFormMain: Boolean;\r
 545     fFormUnit: String;\r
 546     fBounds: TFormBounds;\r
 547     fDefaultSize: Boolean;\r
 548     fMargin: Integer;\r
 549     fDefaultPos: Boolean;\r
 550     fCanResize: Boolean;\r
 551     fCenterOnScr: Boolean;\r
 552     FPreventResizeFlicks: Boolean;\r
 553     FDoubleBuffered: Boolean;\r
 554     FTransparent: Boolean;\r
 555     FAlphaBlend: Integer;\r
 556     FHasBorder: Boolean;\r
 557     FStayOnTop: Boolean;\r
 558     FHasCaption: Boolean;\r
 559     FCtl3D: Boolean;\r
 560     FModalResult: Integer;\r
 561     FWindowState: KOL.TWindowState;\r
 562     FOnChar: TOnChar;\r
 563     fOnClick: TOnEvent;\r
 564     FOnLeave: TOnEvent;\r
 565     FOnMouseEnter: TOnEvent;\r
 566     FOnEnter: TOnEvent;\r
 567     FOnMouseLeave: TOnEvent;\r
 568     FOnKeyUp: TOnKey;\r
 569     FOnKeyDown: TOnKey;\r
 570     FOnMouseMove: TOnMouse;\r
 571     FOnMouseWheel: TOnMouse;\r
 572     FOnMouseDown: TOnMouse;\r
 573     FOnMouseUp: TOnMouse;\r
 574     FOnResize: TOnEvent;\r
 575     FMaximizeIcon: Boolean;\r
 576     FMinimizeIcon: Boolean;\r
 577     FCloseIcon: Boolean;\r
 578     FIcon: String;\r
 579     FCursor: String;\r
 580     fFont: TKOLFont;\r
 581     fBrush: TKOLBrush;\r
 582     FOnFormCreate: TOnEvent;\r
 583     FParentLikeFontControls: TList;\r
 584     FParentLikeColorControls: TList;\r
 585     FMinimizeNormalAnimated: Boolean;\r
 586     FOnShow: TOnEvent;\r
 587     FOnHide: TOnEvent;\r
 588     FzOrderChildren: Boolean;\r
 589     FSimpleStatusText: String;\r
 590     FStatusText: TStringList;\r
 591     fOnMouseDblClk: TOnMouse;\r
 592     FMarginLeft: Integer;\r
 593     FMarginTop: Integer;\r
 594     FMarginBottom: Integer;\r
 595     FMarginRight: Integer;\r
 596     FOnEraseBkgnd: TOnPaint;\r
 597     FOnPaint: TOnPaint;\r
 598     FEraseBackground: Boolean;\r
 599     FOnMove: TOnEvent;\r
 600     FSupportMnemonics: Boolean;\r
 601     FStatusSizeGrip: Boolean;\r
 602     FPaintType: TPaintType;\r
 603     FRealignTimer: TTimer;\r
 604     FChangeTimer: TTimer;\r
 605     FMinWidth: Integer;\r
 606     FMaxWidth: Integer;\r
 607     FMinHeight: Integer;\r
 608     FMaxHeight: Integer;\r
 609     FOnDropFiles: TOnDropFiles;\r
 610     FpopupMenu: TKOLPopupMenu;\r
 611     FOnMaximize: TOnEvent;\r
 612     FLocalizy: Boolean;\r
 613     FHelpContext: Integer;\r
 614     FhelpContextIcon: Boolean;\r
 615     FOnHelp: TOnHelp;\r
 616     fDefaultBtnCtl, fCancelBtnCtl: TKOLCustomControl;\r
 617     FborderStyle: TKOLFormBorderStyle;  {YS}\r
 618     FGetShowHint: Boolean;\r
 619     FOnBeforeCreateWindow: TOnEvent;  {YS}\r
 620     function GetFormUnit: String;\r
 621     procedure SetFormMain(const Value: Boolean);\r
 622     procedure SetFormUnit(const Value: String);\r
 623     function GetFormMain: Boolean;\r
 624 \r
 625     function GetSelf: TKOLForm;\r
 626     procedure SetDefaultSize(const Value: Boolean);\r
 627     procedure SetMargin(const Value: Integer);\r
 628     procedure SetDefaultPos(const Value: Boolean);\r
 629     procedure SetCanResize(const Value: Boolean);\r
 630     procedure SetCenterOnScr(const Value: Boolean);\r
 631     procedure SetAlphaBlend(Value: Integer);\r
 632     procedure SetDoubleBuffered(const Value: Boolean);\r
 633     procedure SetPreventResizeFlicks(const Value: Boolean);\r
 634     procedure SetTransparent(const Value: Boolean);\r
 635     procedure SetHasBorder(const Value: Boolean);\r
 636     procedure SetStayOnTop(const Value: Boolean);\r
 637     procedure SetHasCaption(const Value: Boolean);\r
 638     procedure SetCtl3D(const Value: Boolean);\r
 639     procedure SetModalResult(const Value: Integer);\r
 640     procedure SetWindowState(const Value: KOL.TWindowState);\r
 641     procedure SetOnChar(const Value: TOnChar);\r
 642     procedure SetOnClick(const Value: TOnEvent);\r
 643     procedure SetOnEnter(const Value: TOnEvent);\r
 644     procedure SetOnKeyDown(const Value: TOnKey);\r
 645     procedure SetOnKeyUp(const Value: TOnKey);\r
 646     procedure SetOnLeave(const Value: TOnEvent);\r
 647     procedure SetOnMouseDown(const Value: TOnMouse);\r
 648     procedure SetOnMouseEnter(const Value: TOnEvent);\r
 649     procedure SetOnMouseLeave(const Value: TOnEvent);\r
 650     procedure SetOnMouseMove(const Value: TOnMouse);\r
 651     procedure SetOnMouseUp(const Value: TOnMouse);\r
 652     procedure SetOnMouseWheel(const Value: TOnMouse);\r
 653     procedure SetOnResize(const Value: TOnEvent);\r
 654     procedure SetMaximizeIcon(const Value: Boolean);\r
 655     procedure SetMinimizeIcon(const Value: Boolean);\r
 656     procedure SetCloseIcon(const Value: Boolean);\r
 657     procedure SetCursor(const Value: String);\r
 658     procedure SetIcon(const Value: String);\r
 659     function Get_Color: TColor;\r
 660     procedure Set_Color(const Value: TColor);\r
 661     procedure SetFont(const Value: TKOLFont);\r
 662     procedure SetBrush(const Value: TKOLBrush);\r
 663     procedure SetOnFormCreate(const Value: TOnEvent);\r
 664     procedure CollectChildrenWithParentFont;\r
 665     procedure ApplyFontToChildren;\r
 666     procedure CollectChildrenWithParentColor;\r
 667     procedure ApplyColorToChildren;\r
 668     procedure SetMinimizeNormalAnimated(const Value: Boolean);\r
 669     procedure SetLocked(const Value: Boolean);\r
 670     procedure SetOnShow(const Value: TOnEvent);\r
 671     procedure SetOnHide(const Value: TOnEvent);\r
 672     procedure SetzOrderChildren(const Value: Boolean);\r
 673     procedure SetSimpleStatusText(const Value: String);\r
 674     function GetStatusText: TStrings;\r
 675     procedure SetStatusText(const Value: TStrings);\r
 676     procedure SetOnMouseDblClk(const Value: TOnMouse);\r
 677     procedure SetMarginBottom(const Value: Integer);\r
 678     procedure SetMarginLeft(const Value: Integer);\r
 679     procedure SetMarginRight(const Value: Integer);\r
 680     procedure SetMarginTop(const Value: Integer);\r
 681     procedure SetOnEraseBkgnd(const Value: TOnPaint);\r
 682     procedure SetOnPaint(const Value: TOnPaint);\r
 683     procedure SetEraseBackground(const Value: Boolean);\r
 684     procedure SetOnMove(const Value: TOnEvent);\r
 685     procedure SetSupportMnemonics(const Value: Boolean);\r
 686     procedure SetStatusSizeGrip(const Value: Boolean);\r
 687     procedure SetPaintType(const Value: TPaintType);\r
 688     procedure SetMaxHeight(const Value: Integer);\r
 689     procedure SetMaxWidth(const Value: Integer);\r
 690     procedure SetMinHeight(const Value: Integer);\r
 691     procedure SetMinWidth(const Value: Integer);\r
 692     procedure SetOnDropFiles(const Value: TOnDropFiles);\r
 693     procedure SetpopupMenu(const Value: TKOLPopupMenu);\r
 694     procedure SetOnMaximize(const Value: TOnEvent);\r
 695     procedure SetLocalizy(const Value: Boolean);\r
 696     procedure SetHelpContext(const Value: Integer);\r
 697     procedure SethelpContextIcon(const Value: Boolean);\r
 698     procedure SetOnHelp(const Value: TOnHelp);\r
 699     procedure SetborderStyle(const Value: TKOLFormBorderStyle); {YS}\r
 700     procedure SetShowHint(const Value: Boolean);\r
 701     function GetShowHint: Boolean;\r
 702     procedure SetOnBeforeCreateWindow(const Value: TOnEvent); {YS}\r
 703   protected\r
 704     fUniqueID: Integer;\r
 705     FLocked: Boolean;\r
 706     //function CollectOtherFakes: String;\r
 707     function AdditionalUnits: String; virtual;\r
 708     function FormTypeName: String; virtual;\r
 709     function AppletOnForm: Boolean;\r
 710     function GetCaption: String; virtual;\r
 711     procedure SetFormCaption(const Value: String); virtual;\r
 712     function GetFormName: String;\r
 713     procedure SetFormName(const Value: String);\r
 714     function GenerateTransparentInits: String; virtual;\r
 715     function Result_Form: String; virtual;\r
 716 \r
 717     function StringConstant( const Propname, Value: String ): String;\r
 718   public\r
 719     procedure Change( Sender: TComponent ); override;\r
 720     // Methods to generate code of unit, containing form definition.\r
 721     // Ìåòîäû, â êîòîðûõ ãåíåðèòñÿ êîä ìîäóëÿ, ñîäåðæàùåãî ôîðìó\r
 722     procedure DoChangeNow;\r
 723 \r
 724     function GenerateUnit( const Path: String ): Boolean; virtual;\r
 725   protected\r
 726     function GeneratePAS( const Path: String; var Updated: Boolean ): Boolean; virtual;\r
 727     procedure AfterGeneratePas( SL: TStringList ); virtual;\r
 728     function GenerateINC( const Path: String; var Updated: Boolean ): Boolean; virtual;\r
 729     procedure GenerateChildren( SL: TStringList; OfParent: TComponent;\r
 730               const OfParentName: String; const Prefix: String;\r
 731               var Updated: Boolean );\r
 732     procedure GenerateCreateForm( SL: TStringList ); virtual;\r
 733     procedure GenerateDestroyAfterRun( SL: TStringList ); virtual;\r
 734     procedure GenerateAdd2AutoFree( SL: TStringList; const AName: String; AControl: Boolean;\r
 735               Add2AutoFreeProc: String; Obj: TObject ); virtual;\r
 736 \r
 737     procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String );\r
 738               virtual;\r
 739 \r
 740     // Is called after constructing of all child controls and objects\r
 741     // to generate final initialization if needed (only for form object\r
 742     // itself). Now, CanResize property assignment to False is placed\r
 743     // here.\r
 744     //\r
 745     // Âûçûâàåòñÿ óæå ïîñëå ãåíåðàöèè êîíñòðóèðîâàíèÿ âñåõ\r
 746     // äî÷åðíèõ êîíòðîëîâ è îáúåêòîâ ôîðìû - äëÿ ãåíåðàöèè êàêîé-ëèáî\r
 747     // çàâåðøàþùåé èíèöèàëèçàöèè (ñàìîé ôîðìû):\r
 748     procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String );\r
 749               virtual;\r
 750 \r
 751     // Method to assign values to assigned events. Is called in SetupFirst\r
 752     // and actually should call DoAssignEvents, passing a list of (additional)\r
 753     // events to it.\r
 754     //\r
 755     // Ïðîöåäóðà ïðèñâàèâàíèÿ çíà÷åíèé íàçíà÷åííûì ñîáûòèÿì. Âûçûâàåòñÿ èç\r
 756     // SetupFirst è ôàêòè÷åñêè äîëæíà (ïîñëå âûçîâà inherited) ïåðåäàòü\r
 757     // â ïðîöåäóðó DoAssignEvents ñïèñîê (äîïîëíèòåëüíûõ) ñîáûòèé.\r
 758     procedure AssignEvents( SL: TStringList; const AName: String ); override;\r
 759 \r
 760     property PaintType: TPaintType read FPaintType write SetPaintType;\r
 761     procedure InvalidateControls;\r
 762     procedure Loaded; override;\r
 763     procedure GetPaintTypeFromProjectOrOtherForms;\r
 764     function DoNotGenerateSetPosition: Boolean; virtual;\r
 765     procedure RealignTimerTick( Sender: TObject );\r
 766     procedure ChangeTimerTick( Sender: TObject );\r
 767 \r
 768     function BestEventName: String; override;\r
 769   protected\r
 770     ResStrings: TStringList;\r
 771     procedure MakeResourceString( const ResourceConstName, Value: String );\r
 772   public\r
 773     AllowRealign: Boolean;\r
 774     FRealigning: Integer;\r
 775 \r
 776     constructor Create( AOwner: TComponent ); override;\r
 777     destructor Destroy; override;\r
 778 \r
 779     function NextUniqueID: Integer;\r
 780 \r
 781     // Attention! This is very important definition. While designing\r
 782     // mirror form, and writing code in event handlers, such wizard\r
 783     // word must be used everywhere instead default (usually skipped)\r
 784     // word 'Self'. For instance, do not write in your handler\r
 785     //   Left := 100; Such code will be correct only while compiling\r
 786     // mirror project itself, but after converting to KOL an error\r
 787     // will be detected by the compiler. Write instead:\r
 788     //   Form.Left := 100; And this will be correct both in mirror\r
 789     // project and in resulting KOL project.\r
 790     //\r
 791     // Âíèìàíèå! Çäåñü îïðåäåëÿåòñÿ âàæíîå ñëîâî. Â ïðîåêòèðîâàíèè\r
 792     // çåðêàëüíûõ ôîðì ýòî âîëøåáíîå ñëîâî äîëæíî áûòü èñïîëüçîâàíî\r
 793     // âåçäå, ãäå ðàíåå ìîæíî áûëî îïóñòèòü ïîäðàçóìåâàåìîå ñëîâî\r
 794     // Self. Íàïðèìåð, â îáðàáîò÷èêå íåëüçÿ íàïèñàòü Left := 100;\r
 795     // Òàêîé êîä áóäåò ïðàâèëüíûì ïðè êîìïèëÿöèè çåðêàëà, íî ïîñëå\r
 796     // êîíâåðñèè â KOL ïðè ïîïûòêå îòòðàíñëèðîâàòü ïðîåêò òðàíñëÿòîð\r
 797     // âûäàñò îøèáêó. Ñëåäóåò ïèñàòü Form.Left := 100; È òîãäà ýòî\r
 798     // áóäåò ïðàâèëüíî â îáîèõ ïðîåêòàõ.\r
 799     property Form: TKOLForm read GetSelf;\r
 800     property ModalResult: Integer read FModalResult write SetModalResult;\r
 801     property Margin: Integer read fMargin write SetMargin;\r
 802     procedure AlignChildren( PrntCtrl: TKOLCustomControl; Recursive: Boolean );\r
 803   published\r
 804     property Locked: Boolean read FLocked write SetLocked;\r
 805 \r
 806     //property AutoCreate: Boolean read GetAutoCreate write fAutoCreate;\r
 807 \r
 808     // Property FormName - just shows name of VCL form (it is possible to change\r
 809     // it in Object Inspaector). This name will be used as a name of correspondent\r
 810     // variable of type P<FormName> in generated unit (which actually is not\r
 811     // form, but contains Form: PControl as a field).\r
 812     //\r
 813     // Ñâîéñòâî FormName - ïðîñòî ïîêàçûâàåò èìÿ ôîðìû VCL (åùå åãî ìîæíî çäåñü\r
 814     // æå èçìåíèòü). Ýòî èìÿ áóäåò èñïîëüçîâàíî êàê èìÿ ñîîòâåòñòâóþùåé\r
 815     // ïåðåìåííîé ôîðìû òèïà P<FormName> â ñãåíåðèðîâàííîì ìîäóëå äëÿ KOL-ïðîåêòà.\r
 816     // Ýòà ïåðåìåííàÿ íå åñòü òî÷íîå ñîîòâåòñòâèå ôîðìå, íî ñîäåðæèò ïåðåìåíóþ\r
 817     // Form: PControl, â äåéñòâèòåëüíîñòè ñîîòâåòñòâóþùóþ åé.\r
 818     property formName: String read GetFormName write SetFormName stored False;\r
 819 \r
 820     // Unit name, containing form definition.\r
 821     // Èìÿ ìîäóëÿ, â êîòîðîì ñîäåðæèòñÿ ôîðìà.\r
 822     property formUnit: String read GetFormUnit write SetFormUnit;\r
 823 \r
 824     // Form is marked 'main', if it contain also TKOLProject component.\r
 825     // (Main form in KOL playes special role, and can even replace\r
 826     // Applet object if this last is not needed in KOL project - to make\r
 827     // application taskbar button ivisible, for instance).\r
 828     //\r
 829     // Ôîðìà ñ÷èòàåòñÿ ãëàâíîé, åñëè èìåííî íà íåå ïîëîæåí êîìïîíåíò\r
 830     // TKOLProject. Ñîîòâåòñòâåííî çäåñü âîçâðàùàåòñÿ True, òîëüêî åñëè\r
 831     // TKOLForm ëåæèò íà òîé æå ôîðìå, ÷òî è TKOLProject. (Â KOL ãëàâíàÿ\r
 832     // ôîðìà âûïîëíÿåò îñîáóþ ðîëü, è äàæå ìîæåò çàìåùàòü ñîáîé îáúåêò\r
 833     // Applet ïðè åãî îòñóòñòâèè).\r
 834     property formMain: Boolean read GetFormMain write SetFormMain;\r
 835 \r
 836     property Caption: String read GetCaption write SetFormCaption;\r
 837     property Visible;\r
 838     property Enabled;\r
 839 \r
 840     property bounds: TFormBounds read fBounds;\r
 841     property defaultSize: Boolean read fDefaultSize write SetDefaultSize;\r
 842     property defaultPosition: Boolean read fDefaultPos write SetDefaultPos;\r
 843     property MinWidth: Integer read FMinWidth write SetMinWidth;\r
 844     property MinHeight: Integer read FMinHeight write SetMinHeight;\r
 845     property MaxWidth: Integer read FMaxWidth write SetMaxWidth;\r
 846     property MaxHeight: Integer read FMaxHeight write SetMaxHeight;\r
 847 \r
 848     property HasBorder: Boolean read FHasBorder write SetHasBorder;\r
 849     property HasCaption: Boolean read FHasCaption write SetHasCaption;\r
 850     property StayOnTop: Boolean read FStayOnTop write SetStayOnTop;\r
 851     property CanResize: Boolean read fCanResize write SetCanResize;\r
 852     property CenterOnScreen: Boolean read fCenterOnScr write SetCenterOnScr;\r
 853     property Ctl3D: Boolean read FCtl3D write SetCtl3D;\r
 854     property WindowState: KOL.TWindowState read FWindowState write SetWindowState;\r
 855 \r
 856     // These three properties are for design time only:\r
 857     property minimizeIcon: Boolean read FMinimizeIcon write SetMinimizeIcon;\r
 858     property maximizeIcon: Boolean read FMaximizeIcon write SetMaximizeIcon;\r
 859     property closeIcon: Boolean read FCloseIcon write SetCloseIcon;\r
 860     property helpContextIcon: Boolean read FhelpContextIcon write SethelpContextIcon;\r
 861     property borderStyle: TKOLFormBorderStyle read FborderStyle write SetborderStyle; {YS}\r
 862     property HelpContext: Integer read FHelpContext write SetHelpContext;\r
 863 \r
 864     // Properties Icon and Cursor at design time are represented as strings.\r
 865     // These allow to autoload real Icon: HIcon and Cursor: HCursor from\r
 866     // resource with given name. Type here name of resource and use $R directive\r
 867     // to include correspondent res-file into executable.\r
 868     //\r
 869     // Â äèçàéíåðå ñâîéñòâà Icon è Cursor ÿâëÿþòñÿ ñòðîêàìè, ïðåäñòàâëÿþùèìè\r
 870     // ñîáîé èìåíà ñîîòâåòñòâóþùèõ ðåñóðñîâ. Äëÿ ïîäêëþ÷åíèÿ ôàéëîâ, ñîäåðæàùèõ\r
 871     // ýòè ðåñóðñû, èñïîëüçóéòå â ñâîåì ïðîåêòå äèðåêòèâó $R.\r
 872     property Icon: String read FIcon write SetIcon;\r
 873     property Cursor: String read FCursor write SetCursor;\r
 874 \r
 875     property Color: TColor read Get_Color write Set_Color;\r
 876     property Font: TKOLFont read fFont write SetFont;\r
 877     property Brush: TKOLBrush read FBrush write SetBrush;\r
 878 \r
 879     property DoubleBuffered: Boolean read FDoubleBuffered write SetDoubleBuffered;\r
 880     property PreventResizeFlicks: Boolean read FPreventResizeFlicks write SetPreventResizeFlicks;\r
 881     property Transparent: Boolean read FTransparent write SetTransparent;\r
 882     property AlphaBlend: Integer read FAlphaBlend write SetAlphaBlend;\r
 883 \r
 884     property Border: Integer read fMargin write SetMargin;\r
 885     property MarginLeft: Integer read FMarginLeft write SetMarginLeft;\r
 886     property MarginRight: Integer read FMarginRight write SetMarginRight;\r
 887     property MarginTop: Integer read FMarginTop write SetMarginTop;\r
 888     property MarginBottom: Integer read FMarginBottom write SetMarginBottom;\r
 889 \r
 890     property MinimizeNormalAnimated: Boolean read FMinimizeNormalAnimated write SetMinimizeNormalAnimated;\r
 891     property zOrderChildren: Boolean read FzOrderChildren write SetzOrderChildren;\r
 892 \r
 893     property SimpleStatusText: String read FSimpleStatusText write SetSimpleStatusText;\r
 894     property StatusText: TStrings read GetStatusText write SetStatusText;\r
 895     property statusSizeGrip: Boolean read FStatusSizeGrip write SetStatusSizeGrip;\r
 896 \r
 897     property Localizy: Boolean read FLocalizy write SetLocalizy;\r
 898     property ShowHint: Boolean read GetShowHint write SetShowHint;\r
 899     {* To provide tooltip (hint) showing, it is necessary to define conditional\r
 900        symbol USE_MHTOOLTIP in\r
 901        Project|Options|Directories/Conditionals|Conditional Defines. }\r
 902 \r
 903     property OnClick: TOnEvent read fOnClick write SetOnClick;\r
 904     property OnMouseDblClk: TOnMouse read fOnMouseDblClk write SetOnMouseDblClk;\r
 905     property OnMouseDown: TOnMouse read FOnMouseDown write SetOnMouseDown;\r
 906     property OnMouseMove: TOnMouse read FOnMouseMove write SetOnMouseMove;\r
 907     property OnMouseUp: TOnMouse read FOnMouseUp write SetOnMouseUp;\r
 908     property OnMouseWheel: TOnMouse read FOnMouseWheel write SetOnMouseWheel;\r
 909     property OnMouseEnter: TOnEvent read FOnMouseEnter write SetOnMouseEnter;\r
 910     property OnMouseLeave: TOnEvent read FOnMouseLeave write SetOnMouseLeave;\r
 911     property OnEnter: TOnEvent read FOnEnter write SetOnEnter;\r
 912     property OnLeave: TOnEvent read FOnLeave write SetOnLeave;\r
 913     property OnKeyDown: TOnKey read FOnKeyDown write SetOnKeyDown;\r
 914     property OnKeyUp: TOnKey read FOnKeyUp write SetOnKeyUp;\r
 915     property OnChar: TOnChar read FOnChar write SetOnChar;\r
 916     property OnResize: TOnEvent read FOnResize write SetOnResize;\r
 917     property OnMove: TOnEvent read FOnMove write SetOnMove;\r
 918     property OnDestroy;\r
 919     property OnShow: TOnEvent read FOnShow write SetOnShow;\r
 920     property OnHide: TOnEvent read FOnHide write SetOnHide;\r
 921     property OnDropFiles: TOnDropFiles read FOnDropFiles write SetOnDropFiles;\r
 922 \r
 923     property OnFormCreate: TOnEvent read FOnFormCreate write SetOnFormCreate;\r
 924     property OnPaint: TOnPaint read FOnPaint write SetOnPaint;\r
 925     property OnEraseBkgnd: TOnPaint read FOnEraseBkgnd write SetOnEraseBkgnd;\r
 926     property EraseBackground: Boolean read FEraseBackground write SetEraseBackground;\r
 927     property supportMnemonics: Boolean read FSupportMnemonics write SetSupportMnemonics;\r
 928     property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu;\r
 929     property OnMaximize: TOnEvent read FOnMaximize write SetOnMaximize;\r
 930     property OnHelp: TOnHelp read FOnHelp write SetOnHelp;\r
 931 \r
 932     property OnBeforeCreateWindow: TOnEvent read FOnBeforeCreateWindow write SetOnBeforeCreateWindow;\r
 933   end;\r
 934 \r
 935 \r
 936 \r
 937 \r
 938 \r
 939 \r
 940 \r
 941 \r
 942 \r
 943 \r
 944 \r
 945 \r
 946 \r
 947 \r
 948 \r
 949 \r
 950 \r
 951 \r
 952 \r
 953 \r
 954 \r
 955 \r
 956 \r
 957 \r
 958 \r
 959 \r
 960 \r
 961   TNotifyOperation = ( noRenamed, noRemoved, noChanged );\r
 962 \r
 963 \r
 964   //============================================================================\r
 965   // Mirror class TKOLObj approximately corresponds to TObj type in\r
 966   // KOL objects hierarchy. Here we use it as a base to produce mirror\r
 967   // classes, correspondent to non-visual objects in KOL.\r
 968   //\r
 969   // Çåðêàëüíûé êëàññ TKOLObj ïðèáëèçèòåëüíî ñîîòâåòñòâóåò òèïó TObj\r
 970   // â èåðàðõèè îáúåêòîâ KOL. Îò íåãî ïðîèçâîäÿòñÿ êëàññû, çåðêàëüíûå\r
 971   // íåâèçóàëüíûì îáúåêòàì KOL.\r
 972   TKOLObj = class( TComponent )\r
 973   private\r
 974     FOnDestroy: TOnEvent;\r
 975     F_Tag: Integer;\r
 976     FLocalizy: TLocalizyOptions;\r
 977     function Get_Tag:Integer ;\r
 978     procedure SetOnDestroy(const Value: TOnEvent);\r
 979     procedure Set_Tag(const Value: Integer);\r
 980     procedure SetLocalizy(const Value: TLocalizyOptions);\r
 981   protected\r
 982     fUpdated: Boolean;\r
 983 \r
 984     // A list of components which are linked to the TKOLObj component\r
 985     // and must be notifyed when the TKOLObj component is renamed or\r
 986     // removed from a form at design time.\r
 987     fNotifyList: TList;\r
 988 \r
 989     // This priority is used to determine objects of which types should be\r
 990     // created before others\r
 991     fCreationPriority: Integer;\r
 992 \r
 993     // NeedFree is used during code generation to determine if to\r
 994     // generate code to destroy the object together with destroying of\r
 995     // owning form (Usually True, but some objects, like ImageList\r
 996     // can be self-destructing).\r
 997     //\r
 998     // Ïîëå NeedFree èñïîëüçóåòñÿ â êîíâåðòåðå äëÿ îïðåäåëåíèÿ òîãî,\r
 999     // ïîäëåæèò ëè îáúåêò ïðèíóäèòåëüíîìó óíè÷òîæåíèþ ìåòîäîì Free\r
1000     // âìåñòå ñ ýêçåìïëÿðîì åãî ôîðìû (îáû÷íî äà, íî ìîãóò áûòü îáúåêòû\r
1001     // âðîäå ImageList'à, êîòîðûå ðàçðóøàþò ñåáÿ ñàìè).\r
1002     NeedFree: Boolean;\r
1003 \r
1004     procedure SetName( const NewName: TComponentName ); override;\r
1005     procedure FirstCreate; virtual;\r
1006     function AdditionalUnits: String; virtual;\r
1007     procedure GenerateTag( SL: TStringList; const AName, APrefix: String );\r
1008 \r
1009     // This method adds operators of creation of object to the end of SL\r
1010     // and following ones for adjusting object properties and events.\r
1011     //\r
1012     // Ïðîöåäóðà, êîòîðàÿ äîáàâëÿåò â êîíåö SL (:TStringList) îïåðàòîðû\r
1013     // ñîçäàíèÿ îáúåêòà è òå îïåðàòîðû íàñòðîéêè åãî ñâîéñòâ, êîòîðûå\r
1014     // äîëæíû èñïîëíÿòüñÿ íåìåäëåííî âñëåä çà êîíñòðóèðîâàíèåì îáúåêòà:\r
1015     procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String );\r
1016               virtual;\r
1017 \r
1018     // The same as above, but is called after generating of code to\r
1019     // create all child controls and objects - to insert final initialization\r
1020     // code (if needed).\r
1021     //\r
1022     // Àíàëîãè÷íî, íî âûçûâàåòñÿ óæå ïîñëå ãåíåðàöèè êîíñòðóèðîâàíèÿ âñåõ\r
1023     // äî÷åðíèõ êîíòðîëîâ è îáúåêòîâ ôîðìû - äëÿ ãåíåðàöèè êàêîé-ëèáî\r
1024     // çàâåðøàþùåé èíèöèàëèçàöèè:\r
1025     procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String );\r
1026               virtual;\r
1027 \r
1028     procedure DoGenerateConstants( SL: TStringList ); virtual;\r
1029 \r
1030     procedure AssignEvents( SL: TStringList; const AName: String ); virtual;\r
1031 \r
1032     procedure DoAssignEvents( SL: TStringList; const AName: String;\r
1033               EventNames: array of PChar; EventHandlers: array of Pointer );\r
1034     function BestEventName: String; virtual;\r
1035     function NotAutoFree: Boolean; virtual;\r
1036     function CompareFirst(c, n: string): boolean; virtual;\r
1037     function StringConstant( const Propname, Value: String ): String;\r
1038   public\r
1039     procedure Change; virtual;\r
1040     function ParentKOLForm: TKOLForm;\r
1041     function OwnerKOLForm( AOwner: TComponent ): TKOLForm;\r
1042     function ParentForm: TForm;\r
1043 \r
1044     constructor Create( AOwner: TComponent ); override;\r
1045     destructor Destroy; override;\r
1046 \r
1047     procedure AddToNotifyList( Sender: TComponent );\r
1048 \r
1049     // procedure which is called by linked components, when those are\r
1050     // renamed or removed at design time.\r
1051     procedure NotifyLinkedComponent( Sender: TObject; Operation: TNotifyOperation );\r
1052               virtual;\r
1053     procedure DoNotifyLinkedComponents( Operation: TNotifyOperation );\r
1054 \r
1055     // Returns type name without <TKol> prefix. (TKOLTimer -> Timer).\r
1056     //\r
1057     // Äàííàÿ ôóíêöèÿ âîçâðàùàåò èìÿ òèïà îáúåêòà KOL (íàïðèìåð,\r
1058     // çåðêàëüíûé êëàññ TKOLImageList ñîîòâåòñòâóåò òèïó TImageList â\r
1059     // KOL, âîçâðàùàåòñÿ 'ImageList').\r
1060     function TypeName: String; virtual;\r
1061     property Localizy: TLocalizyOptions read FLocalizy write SetLocalizy;\r
1062 \r
1063     property CreationPriority: Integer read fCreationPriority;\r
1064 \r
1065   published\r
1066     property Tag: Integer read Get_Tag write Set_Tag default 0;\r
1067     property OnDestroy: TOnEvent read FOnDestroy write SetOnDestroy;\r
1068   end;\r
1069 \r
1070   TKOLObjectCompEditor = class( TDefaultEditor )\r
1071   private\r
1072   protected\r
1073     FContinue: Boolean;\r
1074     FCount: Integer;\r
1075     BestEventName: String;\r
1076 //////////////////////////////////////////////////////////\r
1077 {$IFDEF _D6orHigher}                                    //\r
1078     FFirst: IProperty;\r
1079     FBest: IProperty;\r
1080     procedure CountEvents(const PropertyEditor: IProperty );\r
1081     procedure CheckEdit(const PropertyEditor: IProperty);\r
1082     procedure EditProperty(const PropertyEditor: IProperty;\r
1083               var Continue: Boolean); override;\r
1084 ////////////\r
1085 {$ELSE}                                                 //\r
1086 //////////////////////////////////////////////////////////\r
1087     FFirst: TPropertyEditor;\r
1088     FBest: TPropertyEditor;\r
1089     procedure CountEvents( PropertyEditor: TPropertyEditor );\r
1090     procedure CheckEdit(PropertyEditor: TPropertyEditor);\r
1091     procedure EditProperty(PropertyEditor: TPropertyEditor;\r
1092       var Continue, FreeEditor: Boolean); override;\r
1093 //////////////////////////////////////////////////////////\r
1094 {$ENDIF}                                                //\r
1095 //////////////////////////////////////////////////////////\r
1096   public\r
1097     procedure Edit; override;\r
1098   end;\r
1099 \r
1100   TKOLOnEventPropEditor = class( TMethodProperty )\r
1101   private\r
1102   protected\r
1103     {$IFDEF _D2}\r
1104     function GetTrimmedEventName: String;\r
1105     function GetFormMethodName: String; virtual;\r
1106     {$ENDIF _D2}\r
1107   public\r
1108     procedure Edit; override;\r
1109   end;\r
1110 \r
1111 \r
1112 \r
1113 \r
1114 \r
1115 \r
1116 \r
1117   //============================================================================\r
1118   //---- MIRROR FOR A MENU ----\r
1119   //---- ÇÅÐÊÀËÎ ÄËß ÌÅÍÞ ----\r
1120   TKOLMenu = class;\r
1121   TKOLMenuItem = class;\r
1122 \r
1123   TKOLAccPrefixes = ( kapShift, kapControl, kapAlt, kapNoinvert );\r
1124   TKOLAccPrefix = set of TKOLAccPrefixes;\r
1125   TVirtualKey = ( vkNotPresent, vkBACK, vkTAB, vkCLEAR, vkENTER, vkPAUSE, vkCAPITAL,\r
1126                   vkESCAPE, vkSPACE, vkPGUP, vkPGDN, vkEND, vkHOME, vkLEFT,\r
1127                   vkUP, vkRIGHT, vkDOWN, vkSELECT, vkEXECUTE, vkPRINTSCREEN,\r
1128                   vkINSERT, vkDELETE, vkHELP, vk0, vk1, vk2, vk3, vk4, vk5,\r
1129                   vk6, vk7, vk8, vk9, vkA, vkB, vkC, vkD, vkE, vkF, vkG, vkH,\r
1130                   vkI, vkJ, vkK, vkL, vkM, vkN, vkO, vkP, vkQ, vkR, vkS, vkT,\r
1131                   vkU, vkV, vkW, vkX, vkY, vkZ, vkLWIN, vkRWIN, vkAPPS,\r
1132                   vkNUM0, vkNUM1, vkNUM2, vkNUM3, vkNUM4, vkNUM5, vkNUM6,\r
1133                   vkNUM7, vkNUM8, vkNUM9, vkMULTIPLY, vkADD, vkSEPARATOR,\r
1134                   vkSUBTRACT, vkDECIMAL, vkDIVIDE, vkF1, vkF2, vkF3, vkF4,\r
1135                   vkF5, vkF6, vkF7, vkF8, vkF9, vkF10, vkF11, vkF12, vkF13,\r
1136                   vkF14, vkF15, vkF16, vkF17, vkF18, vkF19, vkF20, vkF21,\r
1137                   vkF22, vkF23, vkF24, vkNUMLOCK, vkSCROLL, vkATTN, vkCRSEL,\r
1138                   vkEXSEL, vkEREOF, vkPLAY, vkZOOM, vkPA1, vkOEMCLEAR );\r
1139 \r
1140   TKOLAccelerator = class(TPersistent)\r
1141   private\r
1142     FOwner: TComponent;\r
1143     FPrefix: TKOLAccPrefix;\r
1144     FKey: TVirtualKey;\r
1145     procedure SetKey(const Value: TVirtualKey);\r
1146     procedure SetPrefix(const Value: TKOLAccPrefix);\r
1147   protected\r
1148   public\r
1149     procedure Change;\r
1150     function AsText: String;\r
1151   published\r
1152     property Prefix: TKOLAccPrefix read FPrefix write SetPrefix;\r
1153     property Key: TVirtualKey read FKey write SetKey;\r
1154   end;\r
1155 \r
1156   TKOLAcceleratorPropEditor = class( TPropertyEditor )\r
1157   private\r
1158   protected\r
1159   public\r
1160     function GetAttributes: TPropertyAttributes; override;\r
1161     function GetValue: string; override;\r
1162     procedure SetValue(const Value: string); override;\r
1163     procedure Edit; override;\r
1164   end;\r
1165 \r
1166   {$IFDEF _D2orD3}\r
1167     {$WARNINGS OFF}\r
1168   {$ENDIF}\r
1169   TKOLMenuItem = class(TComponent)\r
1170   private\r
1171     FCaption: String;\r
1172     FBitmap: TBitmap;\r
1173     FSubitems: TList;\r
1174     FChecked: Boolean;\r
1175     //FRadioItem: Boolean;\r
1176     FEnabled: Boolean;\r
1177     FVisible: Boolean;\r
1178     FOnMenu: TOnMenuItem;\r
1179     FOnMenuMethodName: String;\r
1180     FSeparator: Boolean;\r
1181     FAccelerator: TKOLAccelerator;\r
1182     FParent: TComponent;\r
1183     FWindowMenu: Boolean;\r
1184     FHelpContext: Integer;\r
1185     Fdefault: Boolean;\r
1186     FRadioGroup: Integer;\r
1187     FbitmapItem: TBitmap;\r
1188     FbitmapChecked: TBitmap;\r
1189     FownerDraw: Boolean;\r
1190     FMenuBreak: TMenuBreak;\r
1191     FTag: Integer;\r
1192     Faction: TKOLAction;\r
1193     procedure SetBitmap(Value: TBitmap);\r
1194     procedure SetCaption(const Value: String);\r
1195     function GetCount: Integer;\r
1196     function GetSubItems(Idx: Integer): TKOLMenuItem;\r
1197     procedure SetChecked(const Value: Boolean);\r
1198     procedure SetEnabled(const Value: Boolean);\r
1199     procedure SetOnMenu(const Value: TOnMenuItem);\r
1200     //procedure SetRadioItem(const Value: Boolean);\r
1201     procedure SetVisible(const Value: Boolean);\r
1202     function GetMenuComponent: TKOLMenu;\r
1203     function GetUplevel: TKOLMenuItem;\r
1204     procedure SetSeparator(const Value: Boolean);\r
1205     function GetItemIndex: Integer;\r
1206     procedure SetItemIndex_Dummy(const Value: Integer);\r
1207     procedure SetAccelerator(const Value: TKOLAccelerator);\r
1208     procedure SetWindowMenu(Value: Boolean);\r
1209     procedure SetHelpContext(const Value: Integer);\r
1210     //procedure LoadRadioItem(R: TReader);\r
1211     //procedure SaveRadioItem(W: TWriter);\r
1212     procedure SetbitmapChecked(const Value: TBitmap);\r
1213     procedure SetbitmapItem(const Value: TBitmap);\r
1214     procedure Setdefault(const Value: Boolean);\r
1215     procedure SetRadioGroup(const Value: Integer);\r
1216     procedure SetownerDraw(const Value: Boolean);\r
1217     procedure SetMenuBreak(const Value: TMenuBreak);\r
1218     procedure SetTag(const Value: Integer);\r
1219     procedure Setaction(const Value: TKOLAction);\r
1220   protected\r
1221     FDestroying: Boolean;\r
1222     FSubItemCount: Integer;\r
1223     procedure SetName( const NewName: TComponentName ); override;\r
1224     procedure DefProps( const Prefix: String; Filer: TFiler );\r
1225     procedure LoadName( R: TReader );\r
1226     procedure SaveName( W: TWriter );\r
1227     procedure LoadCaption( R: TReader );\r
1228     procedure SaveCaption( W: TWriter );\r
1229     procedure LoadEnabled( R: TReader );\r
1230     procedure SaveEnabled( W: TWriter );\r
1231     procedure LoadVisible( R: TReader );\r
1232     procedure SaveVisible( W: TWriter );\r
1233     procedure LoadChecked( R: TReader );\r
1234     procedure SaveChecked( W: TWriter );\r
1235     procedure LoadRadioGroup( R: TReader );\r
1236     procedure SaveRadioGroup( W: TWriter );\r
1237     procedure LoadOnMenu( R: TReader );\r
1238     procedure SaveOnMenu( W: TWriter );\r
1239     procedure LoadSubItemCount( R: TReader );\r
1240     procedure SaveSubItemCount( W: TWriter );\r
1241     procedure LoadBitmap( R: TReader );\r
1242     procedure SaveBitmap( W: TWriter );\r
1243     procedure LoadSeparator( R: TReader );\r
1244     procedure SaveSeparator( W: TWriter );\r
1245     procedure LoadAccel( R: TReader );\r
1246     procedure SaveAccel( W: TWriter );\r
1247     procedure LoadWindowMenu( R: TReader );\r
1248     procedure SaveWindowMenu( W: TWriter );\r
1249     procedure LoadHelpContext( R: TReader );\r
1250     procedure SaveHelpContext( W: TWriter );\r
1251     procedure LoadOwnerDraw( R: TReader );\r
1252     procedure SaveOwnerDraw( W: TWriter );\r
1253     procedure LoadMenuBreak( R: TReader );\r
1254     procedure SaveMenuBreak( W: TWriter );\r
1255     procedure LoadTag( R: TReader );\r
1256     procedure SaveTag( W: TWriter );\r
1257     procedure LoadDefault( R: TReader );\r
1258     procedure SaveDefault( W: TWriter );\r
1259     procedure LoadAction( R: TReader );\r
1260     procedure SaveAction( W: TWriter );\r
1261     procedure Notification(AComponent: TComponent; Operation: TOperation); override;\r
1262 //    procedure Loaded; override;\r
1263   public\r
1264     procedure Change;\r
1265     property Parent: TComponent read FParent;\r
1266     constructor Create( AOwner: TComponent; AParent, Before: TKOLMenuItem );\r
1267     {$IFDEF _D4orHigher} reintroduce; {$ENDIF}\r
1268     destructor Destroy; override;\r
1269     property MenuComponent: TKOLMenu read GetMenuComponent;\r
1270     property UplevelMenuItem: TKOLMenuItem read GetUplevel;\r
1271     property Count: Integer read GetCount;\r
1272     property SubItems[ Idx: Integer ]: TKOLMenuItem read GetSubItems;\r
1273     procedure MoveUp;\r
1274     procedure MoveDown;\r
1275     procedure SetupTemplate( SL: TStringList; FirstItem: Boolean );\r
1276     procedure SetupAttributes( SL: TStringList; const MenuName: String );\r
1277     procedure DesignTimeClick;\r
1278   published\r
1279     property Tag: Integer read FTag write SetTag;\r
1280     property caption: String read FCaption write SetCaption;\r
1281     property bitmap: TBitmap read FBitmap write SetBitmap;\r
1282     property bitmapChecked: TBitmap read FbitmapChecked write SetbitmapChecked;\r
1283     property bitmapItem: TBitmap read FbitmapItem write SetbitmapItem;\r
1284     property default: Boolean read Fdefault write Setdefault;\r
1285     property enabled: Boolean read FEnabled write SetEnabled;\r
1286     property visible: Boolean read FVisible write SetVisible;\r
1287     property checked: Boolean read FChecked write SetChecked;\r
1288     property radioGroup: Integer read FRadioGroup write SetRadioGroup;\r
1289     property separator: Boolean read FSeparator write SetSeparator;\r
1290     property accelerator: TKOLAccelerator read FAccelerator write SetAccelerator;\r
1291     property MenuBreak: TMenuBreak read FMenuBreak write SetMenuBreak;\r
1292     property ownerDraw: Boolean read FownerDraw write SetownerDraw;\r
1293     property OnMenu: TOnMenuItem read FOnMenu write SetOnMenu;\r
1294 \r
1295     // property ItemIndex is to show only in ObjectInspector index of the\r
1296     // item (i.e. integer number, identifying menu item in OnMenu and\r
1297     // OnMenuItem events, and also in utility methods to access item\r
1298     // properties at run time).\r
1299     property itemindex: Integer read GetItemIndex write SetItemIndex_Dummy\r
1300              stored False;\r
1301     property WindowMenu: Boolean read FWindowMenu write SetWindowMenu;\r
1302     property HelpContext: Integer read FHelpContext write SetHelpContext;\r
1303     property action: TKOLAction read Faction write Setaction;\r
1304   end;\r
1305   {$IFDEF _D2orD3}\r
1306     {$WARNINGS ON}\r
1307   {$ENDIF}\r
1308 \r
1309   TKOLMenu = class(TKOLObj)\r
1310   private\r
1311     FItems: TList;\r
1312     FOnMenuItem: TOnMenuItem;\r
1313     Fshowshortcuts: Boolean;\r
1314     FOnUncheckRadioItem: TOnMenuItem;\r
1315     FgenerateConstants: Boolean;\r
1316     FgenearteSepeartorConstants: Boolean;\r
1317     FOnMeasureItem: TOnMeasureItem;\r
1318     FOnDrawItem: TOnDrawItem;\r
1319     function GetCount: Integer;\r
1320     function GetItems(Idx: Integer): TKOLMenuItem;\r
1321     procedure SetOnMenuItem(const Value: TOnMenuItem);\r
1322     procedure Setshowshortcuts(const Value: Boolean);\r
1323     procedure SetOnUncheckRadioItem(const Value: TOnMenuItem);\r
1324     procedure SetgenerateConstants(const Value: Boolean);\r
1325     procedure SetgenearteSepeartorConstants(const Value: Boolean);\r
1326     procedure SetOnMeasureItem(const Value: TOnMeasureItem);\r
1327     procedure SetOnDrawItem(const Value: TOnDrawItem);\r
1328   protected\r
1329     FItemCount: Integer;\r
1330     FUpdateDisabled: Boolean;\r
1331     FUpdateNeeded: Boolean;\r
1332     procedure DefineProperties( Filer: TFiler ); override;\r
1333     procedure LoadItemCount( R: TReader );\r
1334     procedure SaveItemCount( W: TWriter );\r
1335     procedure SetName( const NewName: TComponentName ); override;\r
1336     function OnMenuItemMethodName: String;\r
1337     // Methods to generate code for creating menu:\r
1338     procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;\r
1339     function NotAutoFree: Boolean; override;\r
1340     procedure AssignEvents( SL: TStringList; const AName: String ); override;\r
1341 \r
1342     procedure UpdateDisable;\r
1343     procedure UpdateEnable;\r
1344     procedure UpdateMenu; virtual;\r
1345   public\r
1346     ActiveDesign: TKOLMenuDesign;\r
1347     procedure Change; override;\r
1348     property Items[ Idx: Integer ]: TKOLMenuItem read GetItems;\r
1349     property Count: Integer read GetCount;\r
1350     constructor Create( AOwner: TComponent ); override;\r
1351     destructor Destroy; override;\r
1352     function NameAlreadyUsed( const ItemName: String ): Boolean;\r
1353     procedure SaveTo( WR: TWriter );\r
1354     procedure DoGenerateConstants( SL: TStringList ); override;\r
1355   published\r
1356     property OnMenuItem: TOnMenuItem read FOnMenuItem write SetOnMenuItem;\r
1357     property OnUncheckRadioItem: TOnMenuItem read FOnUncheckRadioItem write SetOnUncheckRadioItem;\r
1358     property showShortcuts: Boolean read Fshowshortcuts write Setshowshortcuts;\r
1359     property generateConstants: Boolean read FgenerateConstants write SetgenerateConstants;\r
1360     property genearteSepeartorConstants: Boolean read FgenearteSepeartorConstants write SetgenearteSepeartorConstants;\r
1361     property OnMeasureItem: TOnMeasureItem read FOnMeasureItem write SetOnMeasureItem;\r
1362     property OnDrawItem: TOnDrawItem read FOnDrawItem write SetOnDrawItem;\r
1363   end;\r
1364 \r
1365   TKOLMainMenu = class(TKOLMenu)\r
1366   private\r
1367   protected\r
1368     FOldWndProc: Pointer;\r
1369     procedure Loaded; override;\r
1370     procedure UpdateMenu; override;\r
1371     procedure RestoreWndProc( Wnd: HWnd );\r
1372   public\r
1373     constructor Create( AOwner: TComponent ); override;\r
1374     destructor Destroy; override;\r
1375     procedure Change; override;\r
1376     procedure RebuildMenubar;\r
1377   published\r
1378     property Localizy;\r
1379   end;\r
1380 \r
1381   TPopupMenuFlag = ( tpmVertical, tpmRightButton, tpmCenterAlign, tpmRightAlign,\r
1382                   tpmVCenterAlign, tpmBottomAlign, tpmHorPosAnimation,\r
1383                   tpmHorNegAnimation, tpmVerPosAnimation, tpmVerNegAnimation,\r
1384                   tpmNoAnimation );\r
1385   TPopupMenuFlags = Set of TPopupMenuFlag;\r
1386 \r
1387   TKOLPopupMenu = class(TKOLMenu)\r
1388   private\r
1389     FOnPopup: TOnEvent;\r
1390     FFlags: TPopupMenuFlags;\r
1391     procedure SetOnPopup(const Value: TOnEvent);\r
1392     procedure SetFlags(const Value: TPopupMenuFlags);\r
1393   protected\r
1394     procedure AssignEvents( SL: TStringList; const AName: String ); override;\r
1395     procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;\r
1396   public\r
1397   published\r
1398     property Flags: TPopupMenuFlags read FFlags write SetFlags;\r
1399     property OnPopup: TOnEvent read FOnPopup write SetOnPopup;\r
1400     property Localizy;\r
1401   end;\r
1402 \r
1403   TKOLMenuEditor = class( TComponentEditor )\r
1404   private\r
1405   protected\r
1406   public\r
1407     procedure Edit; override;\r
1408     procedure ExecuteVerb(Index: Integer); override;\r
1409     function GetVerb(Index: Integer): string; override;\r
1410     function GetVerbCount: Integer; override;\r
1411   end;\r
1412 \r
1413   TKOLOnItemPropEditor = class( TMethodProperty )\r
1414   private\r
1415   protected\r
1416   public\r
1417     function GetValue: string; override;\r
1418     procedure SetValue(const AValue: string); override;\r
1419   end;\r
1420 \r
1421 \r
1422 \r
1423 \r
1424 \r
1425 \r
1426 \r
1427 \r
1428 \r
1429 \r
1430 \r
1431 \r
1432 \r
1433 \r
1434 \r
1435 \r
1436 \r
1437 \r
1438 \r
1439 \r
1440 \r
1441 \r
1442 \r
1443   // Align property (names are another then in VCL).\r
1444   // Ñâîéñòâî âûðàâíèâàíèÿ êîíòðîëà îòíîñèòåëüíî êëèåíòñêîé ÷àñòè ðîäèòåëüêîãî\r
1445   // êîíòðîëà.\r
1446   TKOLAlign = ( caNone, caLeft, caTop, caRight, caBottom, caClient );\r
1447 \r
1448   // Text alignment property.\r
1449   // Ñâîéñòâî âûðàâíèâàíèÿ òåêñòà ïî ãîðèçîíòàëè. Õîòÿ è îïðåäåëåíî äëÿ âñåõ\r
1450   // êîíòðîëîâ, àêòóàëüíî òîëüêî äëÿ êíîïîê è ìåòîê.\r
1451   TTextAlign = ( taLeft, taRight, taCenter );\r
1452 \r
1453   // Text vertical alignment property.\r
1454   // Ñâîéñòâî âûðàâíèâàíèÿ òåêñòà ïî âåðòèêàëè. Õîòÿ è îïðåäåëåíî â KOL äëÿ\r
1455   // âñåõ êîíòðîëîâ, àêòóàëüíî òîëüêî äëÿ êíîïîê è ìåòîê.\r
1456   TVerticalAlign = ( vaTop, vaCenter, vaBottom );\r
1457 \r
1458 \r
1459 \r
1460 \r
1461 \r
1462 \r
1463 \r
1464 \r
1465 \r
1466 {YS}//--------------------------------------------------------------\r
1467 // TKOLVCLParent is KOL control that represents VCL parent control.\r
1468 \r
1469   PKOLVCLParent = ^TKOLVCLParent;\r
1470   TKOLVCLParent = object(kol.TControl)\r
1471   public\r
1472     OldVCLWndProc: TWndMethod;\r
1473     procedure AttachHandle(AHandle: HWND);\r
1474     procedure AssignDynHandlers(Src: PKOLVCLParent);\r
1475   end;\r
1476 \r
1477   TKOLCtrlWrapper = class(TCustomControl)\r
1478   protected\r
1479     FAllowSelfPaint: boolean;\r
1480     FAllowCustomPaint: boolean;\r
1481     FAllowPostPaint: boolean;\r
1482     procedure Change; virtual;\r
1483   protected\r
1484 {$IFNDEF NOT_USE_KOLCtrlWrapper}\r
1485     FKOLParentCtrl: PKOLVCLParent;\r
1486     FRealParent: boolean;\r
1487     FKOLCtrlNeeded: boolean;\r
1488 \r
1489     procedure RemoveParentAttach;\r
1490     procedure CallKOLCtrlWndProc(var Message: TMessage);\r
1491     function GetKOLParentCtrl: PControl;\r
1492   protected\r
1493     FKOLCtrl: PControl;\r
1494 \r
1495     procedure SetParent( Value: TWinControl ); override;\r
1496     procedure WndProc(var Message: TMessage); override;\r
1497     procedure DestroyWindowHandle; override;\r
1498     procedure DestroyWnd; override;\r
1499     procedure CreateWnd; override;\r
1500     procedure PaintWindow(DC: HDC); override;\r
1501     procedure SetAllowSelfPaint(const Value: boolean); virtual;\r
1502     // Override method CreateKOLControl and create instance of real KOL control within it.\r
1503     // Example: FKOLCtrl := NewGroupBox(KOLParentCtrl, '');\r
1504     procedure CreateKOLControl(Recreating: boolean); virtual;\r
1505     // if False control does not paint itself\r
1506     property AllowSelfPaint: boolean read FAllowSelfPaint write SetAllowSelfPaint;\r
1507     // Update control state according to AllowSelfPaint property\r
1508     procedure UpdateAllowSelfPaint;\r
1509     // if False and assigned FKOLCtrl then Paint method is not called for control\r
1510     property AllowCustomPaint: boolean read FAllowCustomPaint write FAllowCustomPaint;\r
1511     // if True and assigned FKOLCtrl then Paint method is called for control\r
1512     property AllowPostPaint: boolean read FAllowPostPaint write FAllowPostPaint;\r
1513     // Called when KOL control has been recreated. You must set all visual properties\r
1514     // of KOL control within this method.\r
1515     procedure KOLControlRecreated; virtual;\r
1516     // Parent of real KOL control\r
1517     property KOLParentCtrl: PControl read GetKOLParentCtrl;\r
1518   public\r
1519     constructor Create( AOwner: TComponent ); override;\r
1520     destructor Destroy; override;\r
1521     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;\r
1522     procedure DefaultHandler(var Message); override;\r
1523     procedure Invalidate; override;\r
1524 {$ENDIF NOT_USE_KOLCtrlWrapper}\r
1525   end;\r
1526 {YS}//--------------------------------------------------------------\r
1527 \r
1528 \r
1529 \r
1530 \r
1531 \r
1532 \r
1533 \r
1534 \r
1535 \r
1536 \r
1537 \r
1538 \r
1539 \r
1540 \r
1541   TOnSetBounds = procedure( Sender: TObject; var NewBounds: TRect ) of object;\r
1542 \r
1543 \r
1544 \r
1545   //============================================================================\r
1546   // BASE CLASS FOR ALL MIRROR CONTROLS.\r
1547   // All controls in KOL are determined in a single object type\r
1548   // TControl. But in Mirror Classes Kit, we are free to have its own\r
1549   // class for every Windows GUI control.\r
1550   //\r
1551   // ÁÀÇÎÂÛÉ ÊËÀÑÑ ÄËß ÂÑÅÕ ÇÅÐÊÀËÜÍÛÕ ÊÎÍÒÐÎËÎÂ\r
1552   // Âñå êîíòðîëû â KOL ïðåäñòàâëåíû â åäèíîì îáúåêîòíîì òèïå TControl.\r
1553   // Íàì íèêòî íå ìåøàåò òåì íå ìåíåå â âèçóàëüíîì âàðèàíòå èìåòü ñâîé\r
1554   // ñîáñòâåííûé çåðêàëüíûé êëàññ, ñîîòâåòñòâóþùèé êàæäîìó êîíòðîëó.\r
1555   TKOLCustomControl = class( TKOLCtrlWrapper )\r
1556   public\r
1557     function Generate_SetSize: String; virtual;\r
1558   private\r
1559     fClsStyle: DWORD;\r
1560     fExStyle: DWORD;\r
1561     fStyle: DWORD;\r
1562     fCaption: String;\r
1563     FTextAlign: TTextAlign;\r
1564     fMargin: Integer;\r
1565     fOnClick: TOnEvent;\r
1566     fCenterOnParent: Boolean;\r
1567     fPlaceDown: Boolean;\r
1568     fPlaceUnder: Boolean;\r
1569     fPlaceRight: Boolean;\r
1570     FCtl3D: Boolean;\r
1571     FOnDropDown: TOnEvent;\r
1572     FOnCloseUp: TOnEvent;\r
1573     FOnBitBtnDraw: TOnBitBtnDraw;\r
1574     FOnMessage: TOnMessage;\r
1575     FTabOrder: Integer;\r
1576     FShadowDeep: Integer;\r
1577     FOnMouseEnter: TOnEvent;\r
1578     FOnMouseLeave: TOnEvent;\r
1579     FOnMouseUp: TOnMouse;\r
1580     FOnMouseMove: TOnMouse;\r
1581     FOnMouseWheel: TOnMouse;\r
1582     FOnMouseDown: TOnMouse;\r
1583     FOnEnter: TOnEvent;\r
1584     FOnLeave: TOnEvent;\r
1585     FOnChar: TOnChar;\r
1586     FOnKeyUp: TOnKey;\r
1587     FOnKeyDown: TOnKey;\r
1588     FFont: TKOLFont;\r
1589     FBrush: TKOLBrush;\r
1590     FTransparent: Boolean;\r
1591     FOnChange: TOnEvent;\r
1592     FDoubleBuffered: Boolean;\r
1593     FAdjustingTabOrder: Boolean;\r
1594     FOnSelChange: TOnEvent;\r
1595     FOnPaint: TOnPaint;\r
1596     FOnResize: TOnEvent;\r
1597     FOnProgress: TOnEvent;\r
1598     FOnDeleteLVItem: TOnDeleteLVItem;\r
1599     FOnDeleteAllLVItems: TOnEvent;\r
1600     FOnLVData: TOnLVData;\r
1601     FOnCompareLVItems: TOnCompareLVItems;\r
1602     FOnColumnClick: TOnLVColumnClick;\r
1603     FOnDrawItem: TOnDrawItem;\r
1604     FOnMeasureItem: TOnMeasureItem;\r
1605     FOnDestroy: TOnEvent;\r
1606     FParentLikeFontControls: TList;\r
1607     FParentLikeColorControls: TList;\r
1608     FOnTBDropDown: TOnEvent;\r
1609     FParentColor: Boolean;\r
1610     FParentFont: Boolean;\r
1611     FOnDropFiles: TOnDropFiles;\r
1612     FOnHide: TOnEvent;\r
1613     FOnShow: TOnEvent;\r
1614     FOnRE_URLClick: TOnEvent;\r
1615     fOnMouseDblClk: TOnMouse;\r
1616     FOnRE_InsOvrMode_Change: TOnEvent;\r
1617     FOnRE_OverURL: TOnEvent;\r
1618     FCursor: String;\r
1619     FFalse: Boolean;\r
1620     FMarginTop: Integer;\r
1621     FMarginLeft: Integer;\r
1622     FMarginRight: Integer;\r
1623     FMarginBottom: Integer;\r
1624     {$IFDEF KOL_MCK}\r
1625     //FParent: PControl;\r
1626     {$ENDIF}\r
1627     FOnEraseBkgnd: TOnPaint;\r
1628     FEraseBackground: Boolean;\r
1629     FOnTVSelChanging: TOnTVSelChanging;\r
1630     FOnTVBeginDrag: TOnTVBeginDrag;\r
1631     FOnTVBeginEdit: TOnTVBeginEdit;\r
1632     FOnTVDelete: TOnTVDelete;\r
1633     FOnTVEndEdit: TOnTVEndEdit;\r
1634     FOnTVExpanded: TOnTVExpanded;\r
1635     FOnTVExpanding: TOnTVExpanding;\r
1636     FOnLVStateChange: TOnLVStateChange;\r
1637     FOnMove: TOnEvent;\r
1638     FOnSplit: TOnSplit;\r
1639     FOnEndEditLVItem: TOnEditLVItem;\r
1640     fChangingNow: Boolean;\r
1641     FTag: Integer;\r
1642     FOnScroll: TOnScroll;\r
1643     FEditTabChar: Boolean;\r
1644     FMinWidth: Integer;\r
1645     FMaxWidth: Integer;\r
1646     FMinHeight: Integer;\r
1647     FMaxHeight: Integer;\r
1648     FLocalizy: TLocalizyOptions;\r
1649     FHelpContext1: Integer;\r
1650     FDefaultBtn: Boolean;\r
1651     FCancelBtn: Boolean;\r
1652     FIsGenerateSize: Boolean;\r
1653     FIsGeneratePosition: Boolean;\r
1654     FUnicode: Boolean;\r
1655     Faction: TKOLAction;\r
1656     procedure SetAlign(const Value: TKOLAlign);\r
1657 \r
1658     procedure SetClsStyle(const Value: DWORD);\r
1659     procedure SetExStyle(const Value: DWORD);\r
1660     procedure SetStyle(const Value: DWORD);\r
1661     function Get_Color: TColor;\r
1662     procedure Set_Color(const Value: TColor);\r
1663     procedure SetOnClick(const Value: TOnEvent);\r
1664     procedure SetCenterOnParent(const Value: Boolean);\r
1665     procedure SetPlaceDown(const Value: Boolean);\r
1666     procedure SetPlaceRight(const Value: Boolean);\r
1667     procedure SetPlaceUnder(const Value: Boolean);\r
1668     procedure SetCtl3D(const Value: Boolean);\r
1669     procedure SetOnDropDown(const Value: TOnEvent);\r
1670     procedure SetOnCloseUp(const Value: TOnEvent);\r
1671     procedure SetOnBitBtnDraw(const Value: TOnBitBtnDraw);\r
1672     procedure SetOnMessage(const Value: TOnMessage);\r
1673     procedure SetTabStop(const Value: Boolean);\r
1674     procedure SetTabOrder(const Value: Integer);\r
1675     procedure SetShadowDeep(const Value: Integer);\r
1676     procedure SetOnMouseDown(const Value: TOnMouse);\r
1677     procedure SetOnMouseEnter(const Value: TOnEvent);\r
1678     procedure SetOnMouseLeave(const Value: TOnEvent);\r
1679     procedure SetOnMouseMove(const Value: TOnMouse);\r
1680     procedure SetOnMouseUp(const Value: TOnMouse);\r
1681     procedure SetOnMouseWheel(const Value: TOnMouse);\r
1682     procedure SetOnEnter(const Value: TOnEvent);\r
1683     procedure SetOnLeave(const Value: TOnEvent);\r
1684     procedure SetOnChar(const Value: TOnChar);\r
1685     procedure SetOnKeyDown(const Value: TOnKey);\r
1686     procedure SetOnKeyUp(const Value: TOnKey);\r
1687     procedure SetFont(const Value: TKOLFont);\r
1688     function GetParentFont: Boolean;\r
1689     procedure SetParentFont(const Value: Boolean);\r
1690     function Get_Visible: Boolean;\r
1691     procedure Set_Visible(const Value: Boolean);\r
1692     function Get_Enabled: Boolean;\r
1693     procedure Set_Enabled(const Value: Boolean);\r
1694     procedure SetTransparent(const Value: Boolean);\r
1695     procedure SetOnChange(const Value: TOnEvent);\r
1696     //function GetHint: String;\r
1697     procedure SetDoubleBuffered(const Value: Boolean);\r
1698     procedure SetOnSelChange(const Value: TOnEvent);\r
1699     procedure SetOnPaint(const Value: TOnPaint);\r
1700     procedure SetOnResize(const Value: TOnEvent);\r
1701     procedure SetOnProgress(const Value: TOnEvent);\r
1702     function GetActualLeft: Integer;\r
1703     function GetActualTop: Integer;\r
1704     procedure SetActualLeft(Value: Integer);\r
1705     procedure SetActualTop(Value: Integer);\r
1706     procedure SetOnDeleteAllLVItems(const Value: TOnEvent);\r
1707     procedure SetOnDeleteLVItem(const Value: TOnDeleteLVItem);\r
1708     procedure SetOnLVData(const Value: TOnLVData);\r
1709     procedure SetOnCompareLVItems(const Value: TOnCompareLVItems);\r
1710     procedure SetOnColumnClick(const Value: TOnLVColumnClick);\r
1711     procedure SetOnDrawItem(const Value: TOnDrawItem);\r
1712     procedure SetOnMeasureItem(const Value: TOnMeasureItem);\r
1713     procedure SetOnDestroy(const Value: TOnEvent);\r
1714     procedure CollectChildrenWithParentFont;\r
1715     procedure ApplyFontToChildren;\r
1716     procedure SetparentColor(const Value: Boolean);\r
1717     function GetParentColor: Boolean;\r
1718     procedure CollectChildrenWithParentColor;\r
1719     procedure ApplyColorToChildren;\r
1720     procedure SetOnTBDropDown(const Value: TOnEvent);\r
1721     procedure SetOnDropFiles(const Value: TOnDropFiles);\r
1722     procedure SetOnHide(const Value: TOnEvent);\r
1723     procedure SetOnShow(const Value: TOnEvent);\r
1724     procedure SetOnRE_URLClick(const Value: TOnEvent);\r
1725     procedure SetOnMouseDblClk(const Value: TOnMouse);\r
1726     procedure SetOnRE_InsOvrMode_Change(const Value: TOnEvent);\r
1727     procedure SetOnRE_OverURL(const Value: TOnEvent);\r
1728     procedure SetCursor(const Value: String);\r
1729     procedure SetMarginBottom(const Value: Integer);\r
1730     procedure SetMarginLeft(const Value: Integer);\r
1731     procedure SetMarginRight(const Value: Integer);\r
1732     procedure SetMarginTop(const Value: Integer);\r
1733     procedure SetOnEraseBkgnd(const Value: TOnPaint);\r
1734     procedure SetEraseBackground(const Value: Boolean);\r
1735     procedure SetOnTVBeginDrag(const Value: TOnTVBeginDrag);\r
1736     procedure SetOnTVBeginEdit(const Value: TOnTVBeginEdit);\r
1737     procedure SetOnTVDelete(const Value: TOnTVDelete);\r
1738     procedure SetOnTVEndEdit(const Value: TOnTVEndEdit);\r
1739     procedure SetOnTVExpanded(const Value: TOnTVExpanded);\r
1740     procedure SetOnTVExpanding(const Value: TOnTVExpanding);\r
1741     procedure SetOnTVSelChanging(const Value: TOnTVSelChanging);\r
1742     procedure SetOnLVStateChange(const Value: TOnLVStateChange);\r
1743     procedure SetOnMove(const Value: TOnEvent);\r
1744     procedure SetOnSplit(const Value: TOnSplit);\r
1745     procedure SetOnEndEditLVItem(const Value: TOnEditLVItem);\r
1746     procedure Set_autoSize(const Value: Boolean);\r
1747     procedure SetTag(const Value: Integer);\r
1748     procedure SetOnScroll(const Value: TOnScroll);\r
1749     procedure SetEditTabChar(const Value: Boolean);\r
1750     procedure SetMaxHeight(const Value: Integer);\r
1751     procedure SetMaxWidth(const Value: Integer);\r
1752     procedure SetMinHeight(const Value: Integer);\r
1753     procedure SetMinWidth(const Value: Integer);\r
1754     procedure SetLocalizy(const Value: TLocalizyOptions);\r
1755     procedure SetHelpContext(const Value: Integer);\r
1756     procedure SetCancelBtn(const Value: Boolean);\r
1757     procedure SetDefaultBtn(const Value: Boolean);\r
1758     procedure SetIgnoreDefault(const Value: Boolean);\r
1759     procedure SetBrush(const Value: TKOLBrush);\r
1760     procedure SetIsGenerateSize(const Value: Boolean);\r
1761     procedure SetIsGeneratePosition(const Value: Boolean);\r
1762     procedure SetUnicode(const Value: Boolean);\r
1763     procedure Setaction(const Value: TKOLAction);\r
1764   private\r
1765     FHint: String;\r
1766     procedure SetHint(const Value: String);\r
1767   protected\r
1768     FVerticalAlign: TVerticalAlign;\r
1769     FTabStop: Boolean;\r
1770     FautoSize: Boolean;\r
1771     fAlign: TKOLAlign;\r
1772     DefaultWidth: Integer;\r
1773     DefaultHeight: Integer;\r
1774     FOnSetBounds: TOnSetBounds;\r
1775     DefaultMarginLeft, DefaultMarginTop, DefaultMarginRight,\r
1776     DefaultMarginBottom: Integer;\r
1777     DefaultAutoSize: Boolean;\r
1778 \r
1779     fUpdated: Boolean;\r
1780     fNoAutoSizeX: Boolean;\r
1781     fAutoSizingNow: Boolean;\r
1782     fAutoSzX, fAutoSzY: Integer;\r
1783     FHasBorder: Boolean;\r
1784     FDefHasBorder: Boolean;\r
1785 \r
1786     FDefIgnoreDefault: Boolean;\r
1787 \r
1788     // A list of components which are linked to the TKOLObj component\r
1789     // and must be notifyed when the TKOLObj component is renamed or\r
1790     // removed from a form at design time.\r
1791     fNotifyList: TList;\r
1792 \r
1793     FIgnoreDefault: Boolean;\r
1794     FResetTabStopByStyle: Boolean;\r
1795 \r
1796     procedure SetVerticalAlign(const Value: TVerticalAlign); virtual;\r
1797     procedure SetHasBorder(const Value: Boolean); virtual;\r
1798     procedure AutoSizeNow; virtual;\r
1799     function AutoSizeRunTime: Boolean; virtual;\r
1800     function AutoWidth( Canvas: graphics.TCanvas ): Integer; virtual;\r
1801     function AutoHeight( Canvas: graphics.TCanvas ): Integer; virtual;\r
1802     function ControlIndex: Integer;\r
1803     function AdditionalUnits: String; virtual;\r
1804     function TabStopByDefault: Boolean; virtual;\r
1805 \r
1806     procedure SetMargin(const Value: Integer); virtual;\r
1807     procedure SetCaption(const Value: String); virtual;\r
1808     procedure SetTextAlign(const Value: TTextAlign); virtual;\r
1809 \r
1810     // This function returns margins between control edges and edges of client\r
1811     // area. These are used to draw border with dark grey at design time.\r
1812     function ClientMargins: TRect; virtual;\r
1813     function DrawMargins: TRect; virtual;\r
1814 \r
1815     function GetTabOrder: Integer; virtual;\r
1816 \r
1817     function ParentControlUseAlign: Boolean;\r
1818 \r
1819     function ParentKOLControl: TComponent;\r
1820     function OwnerKOLForm( AOwner: TComponent ): TKOLForm;\r
1821     function ParentKOLForm: TKOLForm;\r
1822     function ParentForm: TForm;\r
1823     function ParentBounds: TRect;\r
1824     function PrevKOLControl: TKOLCustomControl;\r
1825     function PrevBounds: TRect;\r
1826     function ParentMargin: Integer;\r
1827 \r
1828     function TypeName: String; virtual;\r
1829     procedure BeforeFontChange( SL: TStrings; const AName, Prefix: String ); virtual;\r
1830     function FontPropName: String; virtual;\r
1831     procedure AfterFontChange( SL: TStrings; const AName, Prefix: String ); virtual;\r
1832 \r
1833     // Overriden to exclude prefix 'KOL' from names of all controls, dropped\r
1834     // onto form at design time. (E.g., when TKOLButton is dropped, its name\r
1835     // becomes 'Button1', not 'KOLButton1' as it could be done by default).\r
1836     //\r
1837     // Ïðîöåäóðà SetName ïåðåîïðåäåëåíà äëÿ òîãî, ÷òîáû âûáðàñûâàòü ïðåôèêñ\r
1838     // KOL, ïðèñóòñòâóþùèé â íàçâàíèÿõ çåðêàëüíûõ êëàññîâ, èç âíîâü ñîçäàííûõ\r
1839     // èìåí êîíòðîëîâ. Íàïðèìåð, TKOLButton -> Button1, à íå KOLButton1.\r
1840     procedure SetName( const NewName: TComponentName ); override;\r
1841 \r
1842     procedure SetParent( Value: TWinControl ); override;\r
1843 \r
1844     // This method is created only when control is just dropped onto form.\r
1845     // For mirror classes, reflecting to controls, which should display\r
1846     // its Caption (like buttons, labels, etc.), it is possible in\r
1847     // overriden method to assign name of control itself to Caption property\r
1848     // (for instance).\r
1849     //\r
1850     // Äàííûé ìåòîä áóäåò âûçûâàòüñÿ òîëüêî â ìîìåíò "áðîñàíèÿ" êîíòðîëà\r
1851     // íà ôîðìó. Äëÿ çåðêàë êíîïîê, ìåòîê è äð. êîíòðîëîâ ñ çàãîëîâêîì,\r
1852     // èìååò ñìûñë ïåðåîïðåäåëèòü ýòîò ìåòîä, ÷òîáû èíèöèàëèçèðîâàòü åãî\r
1853     // Caption èìåíåì ñîçäàâàåìîãî îáúåêòà.\r
1854     procedure FirstCreate; virtual;\r
1855 \r
1856     property TextAlign: TTextAlign read FTextAlign write SetTextAlign;\r
1857     property VerticalAlign: TVerticalAlign read FVerticalAlign write SetVerticalAlign;\r
1858 \r
1859     function RefName: String; virtual;\r
1860     function IsCursorDefault: Boolean; virtual;\r
1861 \r
1862     // Is called to generate constructor of control and operators to\r
1863     // adjust its properties first time.\r
1864     //\r
1865     // Ïðîöåäóðà, êîòîðàÿ äîáàâëÿåò â êîíåö SL (:TStringList) îïåðàòîðû\r
1866     // ñîçäàíèÿ îáúåêòà è òå îïåðàòîðû íàñòðîéêè åãî ñâîéñòâ, êîòîðûå\r
1867     // äîëæíû èñïîëíÿòüñÿ íåìåäëåííî âñëåä çà êîíñòðóèðîâàíèåì îáúåêòà:\r
1868     procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); virtual;\r
1869     procedure SetupConstruct( SL: TStringList; const AName, AParent, Prefix: String ); virtual;\r
1870     procedure DoGenerateConstants( SL: TStringList ); virtual;\r
1871 \r
1872     procedure SetupTabOrder( SL: TStringList; const AName: String ); virtual;\r
1873     function DefaultColor: TColor; virtual;\r
1874     {* by default, clBtnFace. Override it for controls, having another\r
1875        Color as default. Usually these are controls, which main purpose is\r
1876        input (edit controls, list box, list view, tree view, etc.) }\r
1877     function DefaultInitialColor: TColor; virtual;\r
1878     {* by default, DefaultColor is returned. For some controls this\r
1879        value can be overriden to force setting desired Color when the\r
1880        control is created first time (just dropped onto form in designer).\r
1881        E.g., this value is overriden for TKOLCombobox, which DefaultColor\r
1882        is clWindow. }\r
1883     function DefaultParentColor: Boolean; virtual;\r
1884     {* TRUE, if parentColor should be set to TRUE when the control is\r
1885        create (first dropped on form at design time). By default, this\r
1886        property is TRUE for controls with DefaultColor=clBtnFace and\r
1887        FALSE for all other controls. }\r
1888     function DefaultKOLParentColor: Boolean; virtual;\r
1889     {* TRUE, if the control is using Color of parent at run time\r
1890        by default. At least combo box control is using clWhite\r
1891        instead, so this function is overriden for it. This method\r
1892        is introduced to optimise code generated. }\r
1893     function CanChangeColor: Boolean; virtual;\r
1894     {* TRUE, if the Color can be changed (default). This function is\r
1895        overriden for TKOLButton, which represents standard GDI button\r
1896        and can not have other color then clBtnFace.  }\r
1897     procedure SetupColor( SL: TStrings; const AName: String ); virtual;\r
1898     //function RunTimeFont: TKOLFont;\r
1899     function Get_ParentFont: TKOLFont;\r
1900     procedure SetupFont( SL: TStrings; const AName: String ); virtual;\r
1901     procedure SetupTextAlign( SL: TStrings; const AName: String ); virtual;\r
1902 \r
1903     // Is called after generating of constructors of all child controls and\r
1904     // objects - to generate final initialization of object (if necessary).\r
1905     //\r
1906     // Âûçûâàåòñÿ óæå ïîñëå ãåíåðàöèè êîíñòðóèðîâàíèÿ âñåõ\r
1907     // äî÷åðíèõ êîíòðîëîâ è îáúåêòîâ ôîðìû - äëÿ ãåíåðàöèè êàêîé-ëèáî\r
1908     // çàâåðøàþùåé èíèöèàëèçàöèè:\r
1909     procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String );\r
1910               virtual;\r
1911 \r
1912     // Method, which should return string with parameters for constructor\r
1913     // call. I.e. braces content in operator\r
1914     //     Result.Button1 := NewButton( ... )...;\r
1915     //\r
1916     // Ôóíêöèÿ, êîòîðàÿ ôîðìèðóåò ïðàâèëüíûå ïàðàìåòðû äëÿ îïåðàòîðà\r
1917     // êîíñòðóèðîâàíèÿ îáúåêòà (ò.å. òî, ÷òî áóäåò â êðóãëûõ ñêîáêàõ\r
1918     // â îïåðàòîðå: Result.Button1 := NewButton( ... )...;\r
1919     function SetupParams( const AName, AParent: String ): String; virtual;\r
1920 \r
1921     // Method to assign values to assigned events. Is called in SetupFirst\r
1922     // and actually should call DoAssignEvents, passing a list of (additional)\r
1923     // events to it.\r
1924     //\r
1925     // Ïðîöåäóðà ïðèñâàèâàíèÿ çíà÷åíèé íàçíà÷åííûì ñîáûòèÿì. Âûçûâàåòñÿ èç\r
1926     // SetupFirst è ôàêòè÷åñêè äîëæíà (ïîñëå âûçîâà inherited) ïåðåäàòü\r
1927     // â ïðîöåäóðó DoAssignEvents ñïèñîê (äîïîëíèòåëüíûõ) ñîáûòèé.\r
1928     procedure AssignEvents( SL: TStringList; const AName: String ); virtual;\r
1929 \r
1930     procedure DoAssignEvents( SL: TStringList; const AName: String;\r
1931               EventNames: array of PChar; EventHandlers: array of Pointer );\r
1932 \r
1933     // This method allows to initializy part of properties as a sequence\r
1934     // of "transparent" methods calls (see KOL documentation).\r
1935     //\r
1936     // Ôóíêöèÿ, êîòîðàÿ èíèöèàëèçàöèþ ÷àñòè ñâîéñòâ âûïîëíÿåò â âèäå\r
1937     // ïîñëåäîâàòåëüíîñòè âûçîâîâ "ïðîçðà÷íûõ" ìåòîäîâ (ñì. îïèñàíèå KOL)\r
1938     function GenerateTransparentInits: String; virtual;\r
1939 \r
1940     property ShadowDeep: Integer read FShadowDeep write SetShadowDeep;\r
1941 \r
1942     property OnDropDown: TOnEvent read FOnDropDown write SetOnDropDown;\r
1943     property OnCloseUp: TOnEvent read FOnCloseUp write SetOnCloseUp;\r
1944     property OnBitBtnDraw: TOnBitBtnDraw read FOnBitBtnDraw write SetOnBitBtnDraw;\r
1945     property OnChange: TOnEvent read FOnChange write SetOnChange;\r
1946     property OnSelChange: TOnEvent read FOnSelChange write SetOnSelChange;\r
1947     property OnProgress: TOnEvent read FOnProgress write SetOnProgress;\r
1948     property OnDeleteLVItem: TOnDeleteLVItem read FOnDeleteLVItem write SetOnDeleteLVItem;\r
1949     property OnDeleteAllLVItems: TOnEvent read FOnDeleteAllLVItems write SetOnDeleteAllLVItems;\r
1950     property OnLVData: TOnLVData read FOnLVData write SetOnLVData;\r
1951     property OnCompareLVItems: TOnCompareLVItems read FOnCompareLVItems write SetOnCompareLVItems;\r
1952     property OnColumnClick: TOnLVColumnClick read FOnColumnClick write SetOnColumnClick;\r
1953     property OnLVStateChange: TOnLVStateChange read FOnLVStateChange write SetOnLVStateChange;\r
1954     property OnEndEditLVItem: TOnEditLVItem read FOnEndEditLVItem write SetOnEndEditLVItem;\r
1955     property OnDrawItem: TOnDrawItem read FOnDrawItem write SetOnDrawItem;\r
1956     property OnMeasureItem: TOnMeasureItem read FOnMeasureItem write SetOnMeasureItem;\r
1957     property OnTBDropDown: TOnEvent read FOnTBDropDown write SetOnTBDropDown;\r
1958     property OnSplit: TOnSplit read FOnSplit write SetOnSplit;\r
1959     property OnScroll: TOnScroll read FOnScroll write SetOnScroll;\r
1960 \r
1961     // Following two properties are to manipulate with Left and Top, corrected\r
1962     // to parent's client origin, which can be another than (0,0).\r
1963     //\r
1964     // Ñëåäóþùèå 2 ñâîéñòâà - äëÿ ðàáîòû ñ Left è Top, ïîäïðàâëåííûìè\r
1965     // â ñîîòâåòñòâèè ñ êîîðäèíàòàìè íà÷àëà êëèåíòñêîé îáëàñòè ðîäèòåëÿ,\r
1966     // êîòîðîå ìîæåò áûòü èíîå, ÷åì ïðîñòî (0,0)\r
1967     property actualLeft: Integer read GetActualLeft write SetActualLeft;\r
1968     property actualTop: Integer read GetActualTop write SetActualTop;\r
1969 \r
1970     procedure WantTabs( Want: Boolean ); virtual;\r
1971     function CanNotChangeFontColor: Boolean; virtual;\r
1972 \r
1973     // Painting of mirror class object by default. It is possible to override it\r
1974     // in derived class to make its image lookin like reflecting object as much\r
1975     // as possible.\r
1976     // To implement WYSIWIG painting, it is necessary to override Paint method,\r
1977     // and call inherited Paint one at the end of execution of the overriden\r
1978     // method (to provide additional painting, controlled by TKOLProject.PaintType\r
1979     // property and TKOLForm.PaintAdditionally property). Also, override method\r
1980     // WYSIWIGPaintImplemented function to return TRUE, this is also necessary\r
1981     // to provide correct additional painting in inherited Paint method.\r
1982     //\r
1983     // Îòðèñîâêà çåðêàëüíîãî îáúåêòà ïî óìîë÷àíèþ. Ìîæíî çàìåíèòü â íàñëåäóåìîì\r
1984     // êëàññå êîíêðåòíîãî çåðêàëüíîãî êëàññà íà ïðîöåäóðó, â êîòîðîé îáúåêò\r
1985     // èçîáðàæàåòñÿ ìàêñèìàëüíî ïîõîæèì íà îðèãèíàë.\r
1986     // Äëÿ ðåàëèçàöèè îòðèñîâêè êîíòðîëà â ðåæèìå "êàê îí äîëæåí âûãëÿäåòü",\r
1987     // ñëåäóåò ïåðåîïðåäåëèòü ìåòîä Paint, è âûçâàòü óíàñëåäîâàííûé ìåòîä Paint\r
1988     // íà êîíöå èñïîëíåíèÿ ïåðåîïðåäåëåííîãî (äëÿ îáåñïå÷èíèÿ äîïîëíèòåëüíûõ ôóíêöèé\r
1989     // îòðèñîâêè, â ñîîòâåòñòâèè ñî ñâîéñòâàìè TKOLProject.PaintType è\r
1990     // TKOLForm.PaintAdditionally). Òàêæå, ñëåäóåò ïåðåîïðåäåëèòü ôóíêöèþ\r
1991     // WYSIWIGPaintImplemented, ÷òîáû îíà âîçâðàùàëà TRUE - ýòî òàê æå íåîáõîäèìî\r
1992     // äëÿ îáåñïå÷åíèÿ ïðàâèëüíîé äîïîëíèòåëüíîé îòðèñîâêè â óíàñëåäîâàííîì\r
1993     // ìåòîäå Paint.\r
1994     procedure Paint; override;\r
1995 \r
1996     function PaintType: TPaintType;\r
1997     function WYSIWIGPaintImplemented: Boolean; virtual;\r
1998     procedure PrepareCanvasFontForWYSIWIGPaint( ACanvas: TCanvas );\r
1999     function NoDrawFrame: Boolean; virtual;\r
2000 \r
2001     //-- by Alexander Shakhaylo - to allow sort objects\r
2002     function CompareFirst(c, n: string): boolean; virtual;\r
2003 \r
2004     procedure Loaded; override;\r
2005     procedure Notification(AComponent: TComponent; Operation: TOperation); override;\r
2006 \r
2007     function StringConstant( const Propname, Value: String ): String;\r
2008     function BestEventName: String; virtual;\r
2009     function GetDefaultControlFont: HFONT; virtual;\r
2010     procedure KOLControlRecreated;\r
2011     {$IFNDEF NOT_USE_KOLCTRLWRAPPER}\r
2012      override;\r
2013     {$ELSE NOT_USE_KOLCTRLWRAPPER}\r
2014      virtual;\r
2015     procedure CreateKOLControl(Recreating: boolean); virtual;\r
2016     procedure UpdateAllowSelfPaint;\r
2017   protected\r
2018     FKOLCtrl: PControl;\r
2019     FKOLParentCtrl: PControl;\r
2020     property KOLParentCtrl: PControl read FKOLParentCtrl;\r
2021     {$ENDIF NOT_USE_KOLCTRLWRAPPER}\r
2022     property AllowPostPaint: boolean read FAllowPostPaint write FAllowPostPaint;\r
2023     property AllowSelfPaint: boolean read FAllowSelfPaint write FAllowSelfPaint;\r
2024     property AllowCustomPaint: boolean read FAllowCustomPaint write FAllowCustomPaint;\r
2025   public\r
2026     property IsGenerateSize: Boolean read FIsGenerateSize write SetIsGenerateSize;\r
2027     property IsGeneratePosition: Boolean read FIsGeneratePosition write SetIsGeneratePosition;\r
2028     procedure Change; override;\r
2029 \r
2030     constructor Create( AOwner: TComponent ); override;\r
2031     destructor Destroy; override;\r
2032     procedure AddToNotifyList( Sender: TComponent );\r
2033 \r
2034     // procedure which is called by linked components, when those are\r
2035     // renamed or removed at design time.\r
2036     procedure NotifyLinkedComponent( Sender: TObject; Operation: TNotifyOperation );\r
2037               virtual;\r
2038     procedure DoNotifyLinkedComponents( Operation: TNotifyOperation );\r
2039 \r
2040     property Style: DWORD read fStyle write SetStyle;\r
2041     property ExStyle: DWORD read fExStyle write SetExStyle;\r
2042     property ClsStyle: DWORD read fClsStyle write SetClsStyle;\r
2043     procedure Click; override;\r
2044     procedure SetBounds( aLeft, aTop, aWidth, aHeight: Integer ); override;\r
2045     procedure ReAlign( ParentOnly: Boolean );\r
2046     property Transparent: Boolean read FTransparent write SetTransparent;\r
2047 \r
2048     property TabStop: Boolean read FTabStop write SetTabStop;\r
2049 \r
2050     property OnEnter: TOnEvent read FOnEnter write SetOnEnter;\r
2051     property OnLeave: TOnEvent read FOnLeave write SetOnLeave;\r
2052     property OnKeyDown: TOnKey read FOnKeyDown write SetOnKeyDown;\r
2053     property OnKeyUp: TOnKey read FOnKeyUp write SetOnKeyUp;\r
2054     property OnChar: TOnChar read FOnChar write SetOnChar;\r
2055     property Margin: Integer read fMargin write SetMargin;\r
2056     property Border: Integer read fMargin write SetMargin;\r
2057     function BorderNeeded: Boolean; virtual;\r
2058     property MarginLeft: Integer read FMarginLeft write SetMarginLeft;\r
2059     property MarginRight: Integer read FMarginRight write SetMarginRight;\r
2060     property MarginTop: Integer read FMarginTop write SetMarginTop;\r
2061     property MarginBottom: Integer read FMarginBottom write SetMarginBottom;\r
2062     property OnRE_URLClick: TOnEvent read FOnRE_URLClick write SetOnRE_URLClick;\r
2063     property OnRE_OverURL: TOnEvent read FOnRE_OverURL write SetOnRE_OverURL;\r
2064     property OnRE_InsOvrMode_Change: TOnEvent read FOnRE_InsOvrMode_Change write SetOnRE_InsOvrMode_Change;\r
2065     property OnTVBeginDrag: TOnTVBeginDrag read FOnTVBeginDrag write SetOnTVBeginDrag;\r
2066     property OnTVBeginEdit: TOnTVBeginEdit read FOnTVBeginEdit write SetOnTVBeginEdit;\r
2067     property OnTVEndEdit: TOnTVEndEdit read FOnTVEndEdit write SetOnTVEndEdit;\r
2068     property OnTVExpanding: TOnTVExpanding read FOnTVExpanding write SetOnTVExpanding;\r
2069     property OnTVExpanded: TOnTVExpanded read FOnTVExpanded write SetOnTVExpanded;\r
2070     property OnTVDelete: TOnTVDelete read FOnTVDelete write SetOnTVDelete;\r
2071     property OnTVSelChanging: TOnTVSelChanging read FOnTVSelChanging write SetOnTVSelChanging;\r
2072     property autoSize: Boolean read FautoSize write Set_autoSize;\r
2073     property HasBorder: Boolean read FHasBorder write SetHasBorder;\r
2074     property EditTabChar: Boolean read FEditTabChar write SetEditTabChar;\r
2075   //published\r
2076     property TabOrder: Integer read GetTabOrder write SetTabOrder;\r
2077     // This section contains published properties, available in Object\r
2078     // Inspector at design time.\r
2079     //\r
2080     // Â ðàçäåë published ïîïàäàþò ñâîéñòâà, êîòîðûå ìîãóò èçìåíÿòüñÿ èç\r
2081     // Èíñïåêòîðà Îáúåêòîâ â design time. Âîñïîëüçóåìñÿ ýòèì, è ðàçìåñòèì\r
2082     // çäåñü òàêèå ñâîéñòâà âèçóàëüíûõ îáúåêòîâ KOL, êîòîðûå óäîáíî\r
2083     // áûëî áû íàñòðîèòü âèçóàëüíî.\r
2084 \r
2085     // Bound properties can be not overriden, Change is called therefore\r
2086     // when these are changed (because SetBounds is overriden)\r
2087     property Left;\r
2088     property Top;\r
2089     property Width;\r
2090     property Height;\r
2091 \r
2092     property MinWidth: Integer read FMinWidth write SetMinWidth;\r
2093     property MinHeight: Integer read FMinHeight write SetMinHeight;\r
2094     property MaxWidth: Integer read FMaxWidth write SetMaxWidth;\r
2095     property MaxHeight: Integer read FMaxHeight write SetMaxHeight;\r
2096 \r
2097     property Cursor_: String read FCursor write SetCursor;\r
2098     property Cursor: Boolean read FFalse;\r
2099 \r
2100     property PlaceDown: Boolean read fPlaceDown write SetPlaceDown;\r
2101     property PlaceRight: Boolean read fPlaceRight write SetPlaceRight;\r
2102     property PlaceUnder: Boolean read fPlaceUnder write SetPlaceUnder;\r
2103 \r
2104     property Visible: Boolean read Get_Visible write Set_Visible;\r
2105     property Enabled: Boolean read Get_Enabled write Set_Enabled;\r
2106 \r
2107     property DoubleBuffered: Boolean read FDoubleBuffered write SetDoubleBuffered;\r
2108 \r
2109     // Property Align is redeclared to provide type correspondence\r
2110     // (to avoid conflict between VCL.Align and KOL.Align).\r
2111     //\r
2112     // Ñâîéñòâî Align ïåðåîïðåäåëåíî, ÷òîáû îáåñïå÷èòü ñîîòâåòñòâèå\r
2113     // íàèìåíîâàíèé òèïîâ âûðàâíèâàíèÿ ìåæäó VCL.Align è KOL.Align.\r
2114     property Align: TKOLAlign read fAlign write SetAlign;\r
2115 \r
2116     property CenterOnParent: Boolean read fCenterOnParent write SetCenterOnParent;\r
2117 \r
2118     property Caption: String read fCaption write SetCaption;\r
2119     property Ctl3D: Boolean read FCtl3D write SetCtl3D;\r
2120 \r
2121     property Color: TColor read Get_Color write Set_Color;\r
2122     property parentColor: Boolean read GetParentColor write SetparentColor;\r
2123     property Font: TKOLFont read FFont write SetFont;\r
2124     property Brush: TKOLBrush read FBrush write SetBrush;\r
2125     property parentFont: Boolean read GetParentFont write SetParentFont;\r
2126 \r
2127     property OnClick: TOnEvent read fOnClick write SetOnClick;\r
2128     property OnMouseDblClk: TOnMouse read fOnMouseDblClk write SetOnMouseDblClk;\r
2129     property OnDestroy: TOnEvent read FOnDestroy write SetOnDestroy;\r
2130     property OnMessage: TOnMessage read FOnMessage write SetOnMessage;\r
2131     property OnMouseDown: TOnMouse read FOnMouseDown write SetOnMouseDown;\r
2132     property OnMouseMove: TOnMouse read FOnMouseMove write SetOnMouseMove;\r
2133     property OnMouseUp: TOnMouse read FOnMouseUp write SetOnMouseUp;\r
2134     property OnMouseWheel: TOnMouse read FOnMouseWheel write SetOnMouseWheel;\r
2135     property OnMouseEnter: TOnEvent read FOnMouseEnter write SetOnMouseEnter;\r
2136     property OnMouseLeave: TOnEvent read FOnMouseLeave write SetOnMouseLeave;\r
2137     property OnResize: TOnEvent read FOnResize write SetOnResize;\r
2138     property OnMove: TOnEvent read FOnMove write SetOnMove;\r
2139     property OnDropFiles: TOnDropFiles read FOnDropFiles write SetOnDropFiles;\r
2140     property OnShow: TOnEvent read FOnShow write SetOnShow;\r
2141     property OnHide: TOnEvent read FOnHide write SetOnHide;\r
2142     property OnPaint: TOnPaint read FOnPaint write SetOnPaint;\r
2143     property OnEraseBkgnd: TOnPaint read FOnEraseBkgnd write SetOnEraseBkgnd;\r
2144     property EraseBackground: Boolean read FEraseBackground write SetEraseBackground;\r
2145 \r
2146     property Tag: Integer read FTag write SetTag;\r
2147     property Hint: String read FHint write SetHint;\r
2148 \r
2149     property HelpContext: Integer read FHelpContext1 write SetHelpContext;\r
2150     property Localizy: TLocalizyOptions read FLocalizy write SetLocalizy;\r
2151     property DefaultBtn: Boolean read FDefaultBtn write SetDefaultBtn;\r
2152     property CancelBtn: Boolean read FCancelBtn write SetCancelBtn;\r
2153     property Unicode: Boolean read FUnicode write SetUnicode;\r
2154     property action: TKOLAction read Faction write Setaction stored False;\r
2155   published\r
2156     property IgnoreDefault: Boolean read FIgnoreDefault write SetIgnoreDefault;\r
2157   end;\r
2158 \r
2159   TKOLControl = class( TKOLCustomControl )\r
2160   public\r
2161     function Generate_SetSize: String; override;\r
2162     procedure Change; override;\r
2163   published\r
2164     property TabOrder;\r
2165     property Left;\r
2166     property Top;\r
2167     property Width;\r
2168     property Height;\r
2169 \r
2170     property MinWidth;\r
2171     property MinHeight;\r
2172     property MaxWidth;\r
2173     property MaxHeight;\r
2174     property Cursor_;\r
2175     property PlaceDown;\r
2176     property PlaceRight;\r
2177     property PlaceUnder;\r
2178     property Visible;\r
2179     property Enabled;\r
2180     property DoubleBuffered;\r
2181     property Align;\r
2182     property CenterOnParent;\r
2183     property Caption;\r
2184     property Ctl3D;\r
2185     property Color;\r
2186     property parentColor;\r
2187     property Font;\r
2188     property parentFont;\r
2189     property OnClick;\r
2190     property OnMouseDblClk;\r
2191     property OnDestroy;\r
2192     property OnMessage;\r
2193     property OnMouseDown;\r
2194     property OnMouseMove;\r
2195     property OnMouseUp;\r
2196     property OnMouseWheel;\r
2197     property OnMouseEnter;\r
2198     property OnMouseLeave;\r
2199     property OnResize;\r
2200     property OnMove;\r
2201     property OnDropFiles;\r
2202     property OnShow;\r
2203     property OnHide;\r
2204     property OnPaint;\r
2205     property OnEraseBkgnd;\r
2206     property EraseBackground;\r
2207     property Tag;\r
2208     property HelpContext;\r
2209     property Localizy;\r
2210     property Hint;\r
2211   end;\r
2212 \r
2213 \r
2214   {$IFDEF _D5}\r
2215   TLeftPropEditor = class( TIntegerProperty )\r
2216   private\r
2217     function VisualValue: string;\r
2218   protected\r
2219   public\r
2220     procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;\r
2221       ASelected: Boolean); override;\r
2222   end;\r
2223 \r
2224   TTopPropEditor = class( TIntegerProperty )\r
2225   private\r
2226     function VisualValue: string;\r
2227   protected\r
2228   public\r
2229     procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;\r
2230       ASelected: Boolean); override;\r
2231   end;\r
2232   {$ENDIF}\r
2233 \r
2234   TCursorPropEditor = class( TPropertyEditor )\r
2235   private\r
2236   protected\r
2237   public\r
2238     function GetAttributes: TPropertyAttributes; override;\r
2239     procedure GetValues(Proc: TGetStrProc); override;\r
2240     function GetValue: string; override;\r
2241     procedure SetValue(const Value: string); override;\r
2242   end;\r
2243 \r
2244 \r
2245 \r
2246 \r
2247 \r
2248 \r
2249 \r
2250 \r
2251 \r
2252 \r
2253 \r
2254   //============================================================================\r
2255   // Special component, intended to use it instead TKOLForm and to implement a\r
2256   // unit, which contains MDI child form.\r
2257   TKOLMDIChild = class( TKOLForm )\r
2258   private\r
2259     FParentForm: String;\r
2260     fNotAvailable: Boolean;\r
2261     procedure SetParentForm(const Value: String);\r
2262   protected\r
2263     procedure GenerateCreateForm( SL: TStringList ); override;\r
2264     function DoNotGenerateSetPosition: Boolean; override;\r
2265   public\r
2266   published\r
2267     property ParentMDIForm: String read FParentForm write SetParentForm;\r
2268     property OnQueryEndSession: Boolean read fNotAvailable;\r
2269   end;\r
2270 \r
2271   TParentMDIFormPropEditor = class( TPropertyEditor )\r
2272   private\r
2273   protected\r
2274   public\r
2275     function GetAttributes: TPropertyAttributes; override;\r
2276     procedure GetValues(Proc: TGetStrProc); override;\r
2277     function GetValue: string; override;\r
2278     procedure SetValue(const Value: string); override;\r
2279   end;\r
2280 \r
2281 \r
2282   //============================================================================\r
2283   // Special component, intended to use it instead TKOLForm and to implement a\r
2284   // unit, which does not contain a form, but non-visual KOL objects only.\r
2285   TDataModuleHowToDestroy = ( ddAfterRun, ddOnAppletDestroy, ddManually );\r
2286 \r
2287   TKOLDataModule = class( TKOLForm )\r
2288   private\r
2289     FOnCreate: TOnEvent;\r
2290     FhowToDestroy: TDataModuleHowToDestroy;\r
2291     procedure SetOnCreate(const Value: TOnEvent);\r
2292     procedure SethowToDestroy(const Value: TDataModuleHowToDestroy);\r
2293   protected\r
2294     fNotAvailable: Boolean;\r
2295     function GenerateTransparentInits: String; override;\r
2296     function GenerateINC( const Path: String; var Updated: Boolean ): Boolean; override;\r
2297     procedure GenerateCreateForm( SL: TStringList ); override;\r
2298     function Result_Form: String; override;\r
2299     procedure GenerateDestroyAfterRun( SL: TStringList ); override;\r
2300     procedure GenerateAdd2AutoFree( SL: TStringList; const AName: String;\r
2301               AControl: Boolean; Add2AutoFreeProc: String; Obj: TObject ); override;\r
2302     procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String );\r
2303       override;\r
2304     procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String );\r
2305       override;\r
2306   public\r
2307   published\r
2308     property Locked;\r
2309     property formName: Boolean read fNotAvailable;\r
2310     property formUnit;\r
2311     property formMain;\r
2312     property defaultPosition: Boolean read fNotAvailable;\r
2313     property Caption: Boolean read fNotAvailable;\r
2314     property Visible: Boolean read fNotAvailable;\r
2315     property Enabled: Boolean read fNotAvailable;\r
2316     property Tabulate: Boolean read fNotAvailable;\r
2317     property TabulateEx: Boolean read fNotAvailable;\r
2318     property bounds: Boolean read fNotAvailable;\r
2319     property defaultSize: Boolean read fNotAvailable;\r
2320     property HasBorder: Boolean read fNotAvailable;\r
2321     property HasCaption: Boolean read fNotAvailable;\r
2322     property MarginLeft: Boolean read fNotAvailable;\r
2323     property MarginTop: Boolean read fNotAvailable;\r
2324     property MarginRight: Boolean read fNotAvailable;\r
2325     property MarginBottom: Boolean read fNotAvailable;\r
2326     property Tag: Boolean read fNotAvailable;\r
2327     property StayOnTop: Boolean read fNotAvailable;\r
2328     property CanResize: Boolean read fNotAvailable;\r
2329     property CenterOnScreen: Boolean read fNotAvailable;\r
2330     property Ctl3D: Boolean read fNotAvailable;\r
2331     property WindowState: Boolean read fNotAvailable;\r
2332     property minimizeIcon: Boolean read fNotAvailable;\r
2333     property maximizeIcon: Boolean read fNotAvailable;\r
2334     property closeIcon: Boolean read fNotAvailable;\r
2335     property Icon: Boolean read fNotAvailable;\r
2336     property Cursor: Boolean read fNotAvailable;\r
2337     property Color: Boolean read fNotAvailable;\r
2338     property Font: Boolean read fNotAvailable;\r
2339     property DoubleBuffered: Boolean read fNotAvailable;\r
2340     property PreventResizeFlicks: Boolean read fNotAvailable;\r
2341     property Transparent: Boolean read fNotAvailable;\r
2342     property AlphaBlend: Boolean read fNotAvailable;\r
2343     property Margin: Boolean read fNotAvailable;\r
2344     property Border: Boolean read fNotAvailable;\r
2345     property MinimizeNormalAnimated: Boolean read fNotAvailable;\r
2346     property zOrderChildren: Boolean read fNotAvailable;\r
2347     property SimpleStatusText: Boolean read fNotAvailable;\r
2348     property StatusText: Boolean read fNotAvailable;\r
2349     property OnClick: Boolean read fNotAvailable;\r
2350     property OnMouseDown: Boolean read fNotAvailable;\r
2351     property OnMouseMove: Boolean read fNotAvailable;\r
2352     property OnMouseUp: Boolean read fNotAvailable;\r
2353     property OnMouseWheel: Boolean read fNotAvailable;\r
2354     property OnMouseEnter: Boolean read fNotAvailable;\r
2355     property OnMouseLeave: Boolean read fNotAvailable;\r
2356     property OnMouseDblClk: Boolean read fNotAvailable;\r
2357     property OnEnter: Boolean read fNotAvailable;\r
2358     property OnLeave: Boolean read fNotAvailable;\r
2359     property OnKeyDown: Boolean read fNotAvailable;\r
2360     property OnKeyUp: Boolean read fNotAvailable;\r
2361     property OnChar: Boolean read fNotAvailable;\r
2362     property OnResize: Boolean read fNotAvailable;\r
2363     property OnShow: Boolean read fNotAvailable;\r
2364     property OnHide: Boolean read fNotAvailable;\r
2365     property OnMessage: Boolean read fNotAvailable;\r
2366     property OnClose: Boolean read fNotAvailable;\r
2367     property OnMinimize: Boolean read fNotAvailable;\r
2368     property OnMaximize: Boolean read fNotAvailable;\r
2369     property OnRestore: Boolean read fNotAvailable;\r
2370     property OnPaint: Boolean read fNotAvailable;\r
2371     property OnEraseBkgnd: Boolean read fNotAvailable;\r
2372 \r
2373     property OnFormCreate: Boolean read fNotAvailable;\r
2374     property OnCreate: TOnEvent read FOnCreate write SetOnCreate;\r
2375     property OnDestroy;\r
2376     property howToDestroy: TDataModuleHowToDestroy read FhowToDestroy write SethowToDestroy;\r
2377 \r
2378     property MinWidth: Boolean read fNotAvailable;\r
2379     property MinHeight: Boolean read fNotAvailable;\r
2380     property MaxWidth: Boolean read fNotAvailable;\r
2381     property MaxHeight: Boolean read fNotAvailable;\r
2382     property OnQueryEndSession: Boolean read fNotAvailable;\r
2383 \r
2384     property HelpContext: Boolean read fNotAvailable;\r
2385     property OnHelp: Boolean read fNotAvailable;\r
2386   end;\r
2387 \r
2388 \r
2389 \r
2390 \r
2391 \r
2392 \r
2393 \r
2394 \r
2395   //============================================================================\r
2396   // Special component, intended to use it instead TKOLForm and to implement a\r
2397   // unit, which can contain several visual and non-visual MCK components, which\r
2398   // can be adjusted at design time on a standalone designer form, and created\r
2399   // on KOL form at run time, like a panel with such controls.\r
2400   TKOLFrame = class( TKOLForm )\r
2401   private\r
2402     FEdgeStyle: TEdgeStyle;\r
2403     fNotAvailable: Boolean;\r
2404     FAlign: TKOLAlign;\r
2405     FCenterOnParent: Boolean;\r
2406     FzOrderTopmost: Boolean;\r
2407     fFrameCaption: String;\r
2408     FParentFont: Boolean;\r
2409     FParentColor: Boolean;\r
2410     procedure SetEdgeStyle(const Value: TEdgeStyle);\r
2411     procedure SetAlign(const Value: TKOLAlign);\r
2412     procedure SetCenterOnParent(const Value: Boolean);\r
2413     procedure SetzOrderTopmost(const Value: Boolean);\r
2414     function GetFrameHeight: Integer;\r
2415     function GetFrameWidth: Integer;\r
2416     procedure SetFrameHeight(const Value: Integer);\r
2417     procedure SetFrameWidth(const Value: Integer);\r
2418     procedure SetFrameCaption(const Value: String);\r
2419     procedure SetParentColor(const Value: Boolean);\r
2420     procedure SetParentFont(const Value: Boolean);\r
2421   protected\r
2422     function AutoCaption: Boolean; override;\r
2423     function GetCaption: String; override;\r
2424     function GenerateTransparentInits: String; override;\r
2425     procedure GenerateCreateForm( SL: TStringList ); override;\r
2426     procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String );\r
2427               override;\r
2428     procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String );\r
2429               override;\r
2430     procedure GenerateAdd2AutoFree( SL: TStringList; const AName: String;\r
2431               AControl: Boolean; Add2AutoFreeProc: String; Obj: TObject ); override;\r
2432   public\r
2433     constructor Create( AOwner: TComponent ); override;\r
2434   published\r
2435     property EdgeStyle: TEdgeStyle read FEdgeStyle write SetEdgeStyle;\r
2436     property FormMain: Boolean read fNotAvailable;\r
2437     property AlphaBlend: Boolean read fNotAvailable;\r
2438     property bounds: Boolean read fNotAvailable;\r
2439     property Width: Integer read GetFrameWidth write SetFrameWidth;\r
2440     property Height: Integer read GetFrameHeight write SetFrameHeight;\r
2441     property Align: TKOLAlign read FAlign write SetAlign;\r
2442     property CenterOnParent: Boolean read FCenterOnParent write SetCenterOnParent;\r
2443     property zOrderTopmost: Boolean read FzOrderTopmost write SetzOrderTopmost;\r
2444     property CanResize: Boolean read fNotAvailable;\r
2445     property defaultPosition: Boolean read fNotAvailable;\r
2446     property defaultSize: Boolean read fNotAvailable;\r
2447     property HasBorder: Boolean read fNotAvailable;\r
2448     property HasCaption: Boolean read fNotAvailable;\r
2449     property Icon: Boolean read fNotAvailable;\r
2450     property maximizeIcon: Boolean read fNotAvailable;\r
2451     property minimizeIcon: Boolean read fNotAvailable;\r
2452     property MinimizeNormalAnimated: Boolean read fNotAvailable;\r
2453     property PreventResizeFlicks: Boolean read fNotAvailable;\r
2454     property SimpleStatusText: Boolean read fNotAvailable;\r
2455     property StatusText: Boolean read fNotAvailable;\r
2456     property StayOnTop: Boolean read fNotAvailable;\r
2457     property Tabulate: Boolean read fNotAvailable;\r
2458     property TabulateEx: Boolean read fNotAvailable;\r
2459     property WindowState: Boolean read fNotAvailable;\r
2460     property Caption: String read fFrameCaption write SetFrameCaption;\r
2461     property ParentColor: Boolean read FParentColor write SetParentColor;\r
2462     property ParentFont: Boolean read FParentFont write SetParentFont;\r
2463     property OnQueryEndSession: Boolean read fNotAvailable;\r
2464     property OnClose: Boolean read fNotAvailable;\r
2465     property OnMinimize: Boolean read fNotAvailable;\r
2466     property OnMaximize: Boolean read fNotAvailable;\r
2467     property OnRestore: Boolean read fNotAvailable;\r
2468     property OnHelp: Boolean read fNotAvailable;\r
2469   end;\r
2470 \r
2471 \r
2472   TKOLAction = class(TKOLObj)\r
2473   private\r
2474     FLinked: TStringList;\r
2475     FActionList: TKOLActionList;\r
2476     FVisible: boolean;\r
2477     FChecked: boolean;\r
2478     FEnabled: boolean;\r
2479     FHelpContext: integer;\r
2480     FHint: string;\r
2481     FCaption: string;\r
2482     FOnExecute: TOnEvent;\r
2483     FAccelerator: TKOLAccelerator;\r
2484     procedure SetCaption(const Value: string);\r
2485     procedure SetChecked(const Value: boolean);\r
2486     procedure SetEnabled(const Value: boolean);\r
2487     procedure SetHelpContext(const Value: integer);\r
2488     procedure SetHint(const Value: string);\r
2489     procedure SetOnExecute(const Value: TOnEvent);\r
2490     procedure SetVisible(const Value: boolean);\r
2491     procedure SetAccelerator(const Value: TKOLAccelerator);\r
2492     procedure SetActionList(const Value: TKOLActionList);\r
2493     function GetIndex: Integer;\r
2494     procedure SetIndex(Value: Integer);\r
2495     procedure ResolveLinks;\r
2496     function FindComponentByPath(const Path: string): TComponent;\r
2497     function GetComponentFullPath(AComponent: TComponent): string;\r
2498     procedure UpdateLinkedComponent(AComponent: TComponent);\r
2499     procedure UpdateLinkedComponents;\r
2500   protected\r
2501     procedure ReadState(Reader: TReader); override;\r
2502     procedure SetParentComponent(AParent: TComponent); override;\r
2503     procedure DefineProperties( Filer: TFiler ); override;\r
2504     procedure LoadLinks(R: TReader);\r
2505     procedure SaveLinks(W: TWriter);\r
2506     procedure Loaded; override;\r
2507     procedure SetName(const NewName: TComponentName); override;\r
2508     procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;\r
2509     procedure Notification(AComponent: TComponent; Operation: TOperation); override;\r
2510   public\r
2511     constructor Create(AOwner: TComponent); override;\r
2512     destructor Destroy; override;\r
2513     function GetParentComponent: TComponent; override;\r
2514     function HasParent: Boolean; override;\r
2515     procedure Assign(Source: TPersistent); override;\r
2516     property ActionList: TKOLActionList read FActionList write SetActionList stored False;\r
2517     property Index: Integer read GetIndex write SetIndex stored False;\r
2518     procedure LinkComponent(const AComponent: TComponent);\r
2519     procedure UnLinkComponent(const AComponent: TComponent);\r
2520   published\r
2521     property Caption: string read FCaption write SetCaption;\r
2522     property Hint: string read FHint write SetHint;\r
2523     property Checked: boolean read FChecked write SetChecked default False;\r
2524     property Enabled: boolean read FEnabled write SetEnabled default True;\r
2525     property Visible: boolean read FVisible write SetVisible default True;\r
2526     property HelpContext: integer read FHelpContext write SetHelpContext default 0;\r
2527     property Accelerator: TKOLAccelerator read FAccelerator write SetAccelerator;\r
2528     property OnExecute: TOnEvent read FOnExecute write SetOnExecute;\r
2529   end;\r
2530 \r
2531   TKOLActionList = class(TKOLObj)\r
2532   private\r
2533     FActions: TList;\r
2534     FOnUpdateActions: TOnEvent;\r
2535     function GetKOLAction(Index: Integer): TKOLAction;\r
2536     procedure SetKOLAction(Index: Integer; const Value: TKOLAction);\r
2537     function GetCount: integer;\r
2538     procedure SetOnUpdateActions(const Value: TOnEvent);\r
2539   protected\r
2540     procedure GetChildren(Proc: TGetChildProc {$IFDEF _D3orHigher} ; Root: TComponent {$ENDIF} ); override;\r
2541     procedure SetChildOrder(Component: TComponent; Order: Integer); override;\r
2542 \r
2543     procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;\r
2544     procedure AssignEvents( SL: TStringList; const AName: String ); override;\r
2545     procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override;\r
2546   public\r
2547     ActiveDesign: TfmActionListEditor;\r
2548     constructor Create(AOwner: TComponent); override;\r
2549     destructor Destroy; override;\r
2550     property Actions[Index: Integer]: TKOLAction read GetKOLAction write SetKOLAction; default;\r
2551     property Count: integer read GetCount;\r
2552     property List: TList read FActions;\r
2553   published\r
2554     property OnUpdateActions: TOnEvent read FOnUpdateActions write SetOnUpdateActions;\r
2555   end;\r
2556 \r
2557   TKOLActionListEditor = class( TComponentEditor )\r
2558   private\r
2559   protected\r
2560   public\r
2561     procedure Edit; override;\r
2562     procedure ExecuteVerb(Index: Integer); override;\r
2563     function GetVerb(Index: Integer): string; override;\r
2564     function GetVerbCount: Integer; override;\r
2565   end;\r
2566 \r
2567 \r
2568 \r
2569 \r
2570 \r
2571 \r
2572 \r
2573 \r
2574 var\r
2575   // Variable KOLProject refers to a TKOLProject instance (must be\r
2576   // single in a project).\r
2577   //\r
2578   // Ïåðåìåííàÿ KOLProject ñîäåðæèò óêàçàòåëü íà ïðåäñòàâèòåëü êëàññà\r
2579   // TKOLProject (êîòîðûé äîëæåí áûòü åäèíñòâåííûì)\r
2580   KOLProject: TKOLProject;\r
2581 \r
2582 function BuildKOLProject: Boolean;\r
2583 \r
2584 var\r
2585   // Applet variable refers to (unnecessary) instance of TKOLApplet\r
2586   // class instance.\r
2587   //\r
2588   // Ïåðåìåííàÿ Applet ñîäåðæèò ññûëêó íà (íåîÿáÿçàòåëüíûé) ïðåäñòàâèòåëü\r
2589   // êëàññà TKOLApplet (ñîîòâåòñòâóþùèé îáúåêòó APPLET â KOL).\r
2590   Applet: TKOLApplet;\r
2591 \r
2592   // List of all TKOLForm objects created - provides access to all of them\r
2593   // (e.g. from TKOLProject) at design time and at run time.\r
2594   //\r
2595   // Ñïèñîê FormsList ñîäåðæèò ññûëêè íà âñå îáúåêòû êëàññà TKOLForm\r
2596   // ïðîåêòà, îáåñïå÷èâàÿ äîñòóï ê íèì èç îáúåêò KOLProject (îí äîëæåí\r
2597   // ñóìåòü ïåðå÷èñëèòü âñå ôîðìû, ÷òîáû ñãåíåðèðîâàòü êîä äëÿ íèõ).\r
2598   FormsList: TList;\r
2599 \r
2600 function Color2Str( Color: TColor ): String;\r
2601 \r
2602 procedure Log( const S: String );\r
2603 procedure Rpt( const S: String );\r
2604 procedure Rpt_Stack;\r
2605 \r
2606 function ProjectSourcePath: String;\r
2607 function Get_ProjectName: String;\r
2608 \r
2609 procedure AddLongTextField( var SL: TStringList; const Prefix:String;\r
2610  const Text:String; const Suffix:String );\r
2611 \r
2612 //*///////////////////////////////////////\r
2613   {$IFDEF _D6orHigher}                  //\r
2614 type\r
2615   IFormDesigner = IDesigner;            //\r
2616   {$ENDIF}                              //\r
2617 //*///////////////////////////////////////\r
2618 \r
2619   {$IFDEF _D2orD3}\r
2620 type\r
2621   IDesigner = TDesigner;\r
2622   IFormDesigner = TFormDesigner;\r
2623   {$ENDIF}\r
2624 \r
2625 \r
2626 function QueryFormDesigner( D: IDesigner; var FD: IFormDesigner ): Boolean;\r
2627 \r
2628 \r
2629 \r
2630 function PCharStringConstant( Sender: TObject; const Propname, Value: String ): String;\r
2631 \r
2632 procedure LoadSource( SL: TStrings; const Path: String );\r
2633 procedure SaveStrings( SL: TStrings; const Path: String; var Updated: Boolean );\r
2634 procedure SaveStringToFile(const Path, Str: String );\r
2635 procedure MarkModified( const Path: String );\r
2636 \r
2637 const\r
2638   Signature = '{ KOL MCK } // Do not remove this line!';\r
2639 \r
2640 \r
2641 \r
2642 procedure Register;\r
2643 \r
2644 {$R KOLmirrors.dcr}\r
2645 \r
2646 implementation\r
2647 \r
2648 uses ShellAPI, shlobj {$IFNDEF _D2}, ActiveX {$ENDIF},\r
2649      mckCtrls, mckObjs;\r
2650 \r
2651   procedure Register;\r
2652   begin\r
2653     RegisterComponents( 'KOL', [ TKOLProject, TKOLApplet, TKOLForm, TKOLMDIChild,\r
2654                                  TKOLDataModule, TKOLFrame, TKOLActionList ] );\r
2655     RegisterComponentEditor( TKOLProject, TKOLProjectBuilder );\r
2656     {$IFDEF _D5}\r
2657     RegisterPropertyEditor( TypeInfo( Integer ), TKOLCustomControl, 'Left', TLeftPropEditor );\r
2658     RegisterPropertyEditor( TypeInfo( Integer ), TKOLCustomControl, 'Top', TTopPropEditor );\r
2659     {$ENDIF}\r
2660     RegisterComponentEditor( TKOLObj, TKOLObjectCompEditor );\r
2661     RegisterComponentEditor( TKOLApplet, TKOLObjectCompEditor );\r
2662     RegisterComponentEditor( TKOLCustomControl, TKOLObjectCompEditor );\r
2663     RegisterPropertyEditor( TypeInfo( TOnEvent ), nil, '', TKOLOnEventPropEditor );\r
2664     RegisterPropertyEditor( TypeInfo( TOnMessage ), nil, '', TKOLOnEventPropEditor );\r
2665     RegisterPropertyEditor( TypeInfo( String ), TKOLCustomControl, 'Cursor_', TCursorPropEditor  );\r
2666     RegisterPropertyEditor( TypeInfo( String ), TKOLForm, 'Cursor', TCursorPropEditor );\r
2667     RegisterPropertyEditor( TypeInfo( String ), TKOLMDIChild, 'ParentMDIForm', TParentMDIFormPropEditor );\r
2668     RegisterComponentEditor( TKOLMenu, TKOLMenuEditor );\r
2669     RegisterPropertyEditor( TypeInfo( TOnMenuItem ), TKOLMenuItem, 'OnMenu',\r
2670                             TKOLOnItemPropEditor );\r
2671     RegisterPropertyEditor( TypeInfo( TKOLAccelerator ), TKOLMenuItem, 'Accelerator',\r
2672                             TKOLAcceleratorPropEditor );\r
2673     RegisterNoIcon([TKOLAction]);\r
2674     RegisterClasses([TKOLAction]);\r
2675     RegisterComponentEditor( TKOLActionList, TKOLActionListEditor );\r
2676     RegisterPropertyEditor( TypeInfo( TKOLAccelerator ), TKOLAction, 'Accelerator',\r
2677                             TKOLAcceleratorPropEditor );\r
2678   end;\r
2679 \r
2680 {$STACKFRAMES ON}\r
2681 function GetCallStack: TStringList;\r
2682 var RegEBP: PDWORD;\r
2683     RetAddr, MinSearchAddr, SrchPtr: PChar;\r
2684     Found: Boolean;\r
2685 begin\r
2686   Result := TStringList.Create;\r
2687   asm\r
2688     MOV RegEBP, EBP\r
2689   end;\r
2690   while TRUE do\r
2691   begin\r
2692     Inc( RegEBP );\r
2693     RetAddr := Pointer( RegEBP^ );\r
2694     MinSearchAddr := RetAddr - 4000;\r
2695     if Integer( MinSearchAddr ) > Integer( RetAddr ) then\r
2696       break;\r
2697     Found := FALSE;\r
2698     SrchPtr := RetAddr - Length( '#$signature$#' ) - 1;\r
2699     while SrchPtr >= MinSearchAddr do\r
2700     begin\r
2701       if SrchPtr = '#$signature$#' then\r
2702       begin\r
2703         Found := TRUE;\r
2704         break;\r
2705       end;\r
2706       Dec( SrchPtr );\r
2707     end;\r
2708     if not Found then break;\r
2709     Inc( SrchPtr, Length( '#$signature$#' ) + 1 );\r
2710     Result.Add( SrchPtr );\r
2711     Dec( RegEBP );\r
2712     RegEBP := Pointer( RegEBP^ );\r
2713   end;\r
2714 end;\r
2715 \r
2716 function CmpInts( X, Y: Integer ): Integer;\r
2717 begin\r
2718   asm\r
2719     jmp @@e_signature\r
2720     DB '#$signature$#', 0\r
2721     DB 'CmpInts', 0\r
2722   @@e_signature:\r
2723   end;\r
2724   if X < Y then\r
2725     Result := -1\r
2726   else\r
2727   if X > Y then\r
2728     Result := 1\r
2729   else\r
2730     Result := 0;\r
2731 end;\r
2732 \r
2733 function IsVCLControl( C: TComponent ): Boolean;\r
2734 var temp: Integer;\r
2735 begin\r
2736   asm\r
2737     jmp @@e_signature\r
2738     DB '#$signature$#', 0\r
2739     DB 'IsVCLControl', 0\r
2740   @@e_signature:\r
2741   end;\r
2742   //----------------------- old\r
2743   {Result := C is controls.TControl;\r
2744   if Result then\r
2745   if (C is TKOLApplet) or (C is TKOLCustomControl) or (C is TOleControl) then\r
2746     Result := FALSE;}\r
2747   //----------------------- new - by Alexander Rabotyagov\r
2748   Result := C is controls.TControl;\r
2749   if Result then\r
2750   if (C is TKOLApplet) or (C is TKOLCustomControl) or (C is TOleControl)\r
2751   then result:=false\r
2752   else begin\r
2753     result:=false;\r
2754     if c.tag<>cKolTag\r
2755     then begin\r
2756       {KOL.ShowQuestion - áîëåå óäîáíî, ïîýòîìó òàê:}\r
2757       temp:=KOL.ShowQuestion('Form contain VCL control!!!'+#13+#10+\r
2758         'Name this VCL control is '+c.name+'.'+#13+#10+\r
2759         'You have choise:'+#13+#10+\r
2760         '1) replace this VCL control - click "Replace"'+#13+#10+\r
2761         '2) ignore this VCL control - click "Ignore"'+#13+#10+\r
2762         '   (it change tag property to '+IntToStr(cKolTag)+','+#13+#10+\r
2763         '   remove it to Private'+#13+#10+\r
2764         '   and change source code to:'+#13+#10+\r
2765         '   {$IFNDEF KOL_MCK}'+c.Name+': '+c.ClassName+';{$ENDIF} {<-- It is a VCL control}'+#13+#10+\r
2766         '3) lock Your project - click "Lock"'\r
2767         ,'Replace/Ignore/Lock');\r
2768       try\r
2769         if temp=1 then c.free;\r
2770         if temp=2 then c.tag:=cKolTag;\r
2771         if temp=3 then result:=true;\r
2772       except\r
2773         Showmessage('Sorry, but can not do it! Your project will be locked!');\r
2774         result:=true;\r
2775       end;\r
2776     end;\r
2777   end;\r
2778 end;\r
2779 \r
2780 {$IFDEF MCKLOG}\r
2781 var EnterLevel: Integer;\r
2782     LevelOKStack: array[ -1000..+1000 ] of Boolean;\r
2783 {$ENDIF MCKLOG}\r
2784 procedure Log( const S: String );\r
2785 begin\r
2786   {$IFDEF MCKLOG}\r
2787   if Copy( S, 1, 2 ) = '->' then\r
2788   begin\r
2789     Inc( EnterLevel );\r
2790     if (EnterLevel >= -1000) and (EnterLevel <= 1000) then\r
2791       LevelOKStack[ EnterLevel ] := FALSE;\r
2792   end\r
2793   else\r
2794   if Copy( S, 1, 2 ) = '<-' then\r
2795   begin\r
2796     if (EnterLevel >= -1000) and (EnterLevel <= 1000) then\r
2797       if not LevelOKStack[ EnterLevel ] then\r
2798         LogFileOutput( 'C:\MCK.log', DateTime2StrShort( Now ) + ' ' +\r
2799                        IntToStr( EnterLevel ) + ' *** Leave not OK *** ' + S );\r
2800     Dec( EnterLevel );\r
2801   end;\r
2802   {$IFDEF MCKLOGwoRPT}\r
2803   if Copy( S, 1, 4 ) = 'Rpt:' then\r
2804     Exit;\r
2805   {$ENDIF MCKLOGwoRPT}\r
2806   {$IFDEF MCKLOGwoTKOLProject}\r
2807   if StrEq( Copy( S, 3, 11 ), 'TKOLProject' ) then\r
2808     Exit;\r
2809   {$ENDIF MCKLOGwoTKOLProject}\r
2810   LogFileOutput( 'C:\MCK.log', DateTime2StrShort( Now ) + ' ' + IntToStr( EnterLevel ) + ' ' + S );\r
2811   {$ENDIF MCKLOG}\r
2812 end;\r
2813 \r
2814 procedure LogOK ;\r
2815 begin\r
2816   {$IFDEF MCKLOG}\r
2817     if (EnterLevel >= -1000) and (EnterLevel <= 1000) then\r
2818       LevelOKStack[ EnterLevel ] := TRUE;\r
2819   {$ENDIF}\r
2820 end;\r
2821 \r
2822 procedure Rpt( const S: String );\r
2823 begin\r
2824   asm\r
2825     jmp @@e_signature\r
2826     DB '#$signature$#', 0\r
2827     DB 'Rpt', 0\r
2828   @@e_signature:\r
2829   end;\r
2830   Log( 'Rpt: ' + S );\r
2831   if KOLProject <> nil then\r
2832     KOLProject.Report( S )\r
2833   {else\r
2834   begin\r
2835     Windows.Beep( 100, 50 );\r
2836     ShowMessage( S );\r
2837   end};\r
2838 end;\r
2839 \r
2840 procedure Rpt_Stack;\r
2841 var StrList: TStringList;\r
2842     I: Integer;\r
2843 begin\r
2844   Rpt( 'Stack:' );\r
2845   StrList := GetCallStack;\r
2846   for I := 0 to StrList.Count-1 do\r
2847     Rpt( StrList[ I ] );\r
2848   StrList.Free;\r
2849 end;\r
2850 \r
2851 function ProjectSourcePath: String;\r
2852 begin\r
2853   asm\r
2854     jmp @@e_signature\r
2855     DB '#$signature$#', 0\r
2856     DB 'ProjectSourcePath', 0\r
2857   @@e_signature:\r
2858   end;\r
2859   Result := '';\r
2860   if KOLProject <> nil then\r
2861     Result := KOLProject.SourcePath\r
2862   else\r
2863   if ToolServices <> nil then\r
2864     Result := ExtractFilePath( ToolServices.GetProjectName );\r
2865 end;\r
2866 \r
2867 function Get_ProjectName: String;\r
2868 begin\r
2869   asm\r
2870     jmp @@e_signature\r
2871     DB '#$signature$#', 0\r
2872     DB 'Get_ProjectName', 0\r
2873   @@e_signature:\r
2874   end;\r
2875   Result := '';\r
2876   if KOLProject <> nil then\r
2877     Result := KOLProject.ProjectName\r
2878   else\r
2879   if ToolServices <> nil then\r
2880     Result := ExtractFileNameWOExt( ToolServices.GetProjectName );\r
2881 end;\r
2882 \r
2883 function ReadTextFromIDE( Reader: TIEditReader ): PChar;\r
2884 var Buf: PChar;\r
2885     Len, Pos: Integer;\r
2886     MS: TMemoryStream;\r
2887 begin\r
2888   asm\r
2889     jmp @@e_signature\r
2890     DB '#$signature$#', 0\r
2891     DB 'ReadTextFromIDE', 0\r
2892   @@e_signature:\r
2893   end;\r
2894   Result := nil;\r
2895   GetMem( Buf, 10000 );\r
2896   MS := TMemoryStream.Create;\r
2897   Pos := 0;\r
2898   try\r
2899 \r
2900     Len := Reader.GetText( 0, Buf, 10000 );\r
2901     while Len > 0 do\r
2902     begin\r
2903       MS.Write( Buf[ 0 ], Len );\r
2904       Pos := Pos + Len;\r
2905       Len := Reader.GetText( Pos, Buf, 10000 );\r
2906     end;\r
2907 \r
2908     if MS.Size > 0 then\r
2909     begin\r
2910       GetMem( Result, MS.Size + 1 );\r
2911       Move( MS.Memory^, Result^, MS.Size );\r
2912       Result[ MS.Size ] := #0;\r
2913     end;\r
2914 \r
2915     //Rpt( IntToStr( MS.Size ) + ' bytes are read from IDE' );\r
2916 \r
2917   except\r
2918     on E: Exception do\r
2919     begin\r
2920       ShowMessage( 'Cannot read text from IDE, exception: ' + E.Message );\r
2921     end;\r
2922   end;\r
2923   FreeMem( Buf );\r
2924   MS.Free;\r
2925 end;\r
2926 \r
2927 {$IFNDEF VER90}\r
2928 {$IFNDEF VER100}\r
2929 function ReadTextFromIDE_0( Reader: IOTAEditReader ): PChar;\r
2930 var Buf: PChar;\r
2931     Len, Pos: Integer;\r
2932     MS: TMemoryStream;\r
2933 begin\r
2934   asm\r
2935     jmp @@e_signature\r
2936     DB '#$signature$#', 0\r
2937     DB 'ReadTextFromIDE_0', 0\r
2938   @@e_signature:\r
2939   end;\r
2940   Result := nil;\r
2941   GetMem( Buf, 10000 );\r
2942   MS := TMemoryStream.Create;\r
2943   Pos := 0;\r
2944   try\r
2945 \r
2946     Len := Reader.GetText( 0, Buf, 10000 );\r
2947     while Len > 0 do\r
2948     begin\r
2949       MS.Write( Buf[ 0 ], Len );\r
2950       Pos := Pos + Len;\r
2951       Len := Reader.GetText( Pos, Buf, 10000 );\r
2952     end;\r
2953 \r
2954     if MS.Size > 0 then\r
2955     begin\r
2956       GetMem( Result, MS.Size + 1 );\r
2957       Move( MS.Memory^, Result^, MS.Size );\r
2958       Result[ MS.Size ] := #0;\r
2959     end;\r
2960 \r
2961     //Rpt( IntToStr( MS.Size ) + ' bytes are read from IDE' );\r
2962 \r
2963   except\r
2964     on E: Exception do\r
2965     begin\r
2966       ShowMessage( 'Cannot read text from IDE, exception(0): ' + E.Message );\r
2967     end;\r
2968   end;\r
2969   FreeMem( Buf );\r
2970   MS.Free;\r
2971 end;\r
2972 {$ENDIF}\r
2973 {$ENDIF}\r
2974 \r
2975 procedure LoadSource( SL: TStrings; const Path: String );\r
2976 var N, I: Integer;\r
2977     S: String;\r
2978     Loaded: Boolean;\r
2979     Module: TIModuleInterface;\r
2980     Editor: TIEditorInterface;\r
2981     Reader: TIEditReader;\r
2982     Buffer: PChar;\r
2983 \r
2984     {$IFNDEF VER90}\r
2985     {$IFNDEF VER100}\r
2986     MS: IOTAModuleServices;\r
2987     M: IOTAModule;\r
2988     E: IOTAEditor;\r
2989     SE: IOTASourceEditor;\r
2990     ER: IOTAEditReader;\r
2991     {$ENDIF}\r
2992     {$ENDIF}\r
2993 \r
2994 begin\r
2995   asm\r
2996     jmp @@e_signature\r
2997     DB '#$signature$#', 0\r
2998     DB 'LoadSource', 0\r
2999   @@e_signature:\r
3000   end;\r
3001   Loaded := False;\r
3002   SL.Clear;\r
3003   if ToolServices <> nil then\r
3004   try\r
3005     //Rpt( 'trying to load from IDE Editor: ' + Path );\r
3006 \r
3007     N := ToolServices.GetUnitCount;\r
3008     for I := 0 to N - 1 do\r
3009     begin\r
3010       S := ToolServices.GetUnitName( I );\r
3011       if AnsiLowerCase( S ) = AnsiLowerCase( Path ) then\r
3012       begin\r
3013         // unit is loaded into IDE editor - make an attempt to get it from there\r
3014         Module := ToolServices.GetModuleInterface( S );\r
3015         if Module <> nil then\r
3016         try\r
3017           Editor := Module.GetEditorInterface;\r
3018           if Editor <> nil then\r
3019           try\r
3020             Reader := Editor.CreateReader;\r
3021             Buffer := nil;\r
3022             if Reader <> nil then\r
3023             try\r
3024               //Rpt( 'Loading source from IDE Editor: ' + Path );\r
3025               Buffer := ReadTextFromIDE( Reader );\r
3026               if Buffer <> nil then\r
3027               begin\r
3028                 SL.Text := Buffer;\r
3029                 Loaded := True;\r
3030                 //Rpt( 'Loaded: ' + Path );\r
3031               end;\r
3032             finally\r
3033               Reader.Free;\r
3034               if Buffer <> nil then\r
3035                 FreeMem( Buffer );\r
3036             end;\r
3037           finally\r
3038             Editor.Free;\r
3039           end;\r
3040         finally\r
3041           Module.Free;\r
3042         end;\r
3043         break;\r
3044       end;\r
3045     end;\r
3046 \r
3047     {$IFNDEF VER90}\r
3048     {$IFNDEF VER100}\r
3049     if not Loaded and (BorlandIDEServices <> nil) then\r
3050     begin\r
3051       if BorlandIDEServices.QueryInterface( IOTAModuleServices, MS ) = 0 then\r
3052       begin\r
3053         M := MS.FindModule( Path );\r
3054         if M <> nil then\r
3055         begin\r
3056           N := M.GetModuleFileCount;\r
3057           for I := 0 to N-1 do\r
3058           begin\r
3059             E := M.GetModuleFileEditor( I );\r
3060             if E.QueryInterface( IOTASourceEditor, SE ) = 0 then\r
3061             begin\r
3062               ER := SE.CreateReader;\r
3063               if ER <> nil then\r
3064               begin\r
3065                 Buffer := ReadTextFromIDE_0( ER );\r
3066                 if Buffer <> nil then\r
3067                 begin\r
3068                   SL.Text := Buffer;\r
3069                   Loaded := True;\r
3070                   //Rpt( 'Loaded_0: ' + Path );\r
3071                 end;\r
3072                 break;\r
3073               end;\r
3074             end;\r
3075           end;\r
3076         end;\r
3077       end;\r
3078     end;\r
3079     {$ENDIF}\r
3080     {$ENDIF}\r
3081 \r
3082   except\r
3083     on E: Exception do\r
3084     begin\r
3085       ShowMessage( 'Can not load source of ' + Path + ', exception: ' + E.Message );\r
3086     end;\r
3087   end;\r
3088 \r
3089   if not Loaded then\r
3090   if FileExists( Path ) then\r
3091     SL.LoadFromFile( Path );\r
3092 \r
3093 end;\r
3094 \r
3095 function UpdateSource( SL: TStrings; const Path: String ): Boolean;\r
3096 var N, I: Integer;\r
3097     S: String;\r
3098     Module: TIModuleInterface;\r
3099     Editor: TIEditorInterface;\r
3100     Writer: TIEditWriter;\r
3101     Buffer: String;\r
3102 \r
3103     {$IFNDEF VER90}\r
3104     {$IFNDEF VER100}\r
3105     MS: IOTAModuleServices;\r
3106     M: IOTAModule;\r
3107     E: IOTAEditor;\r
3108     SE: IOTASourceEditor;\r
3109     {$IFNDEF VER120}\r
3110     EB: IOTAEditBuffer;\r
3111     RO: Boolean;\r
3112     {$ENDIF}\r
3113     EW: IOTAEditWriter;\r
3114     {$ENDIF}\r
3115     {$ENDIF}\r
3116 begin\r
3117   asm\r
3118     jmp @@e_signature\r
3119     DB '#$signature$#', 0\r
3120     DB 'UpdateSource', 0\r
3121   @@e_signature:\r
3122   end;\r
3123   Rpt( 'Updating source for ' + Path );\r
3124   //Rpt_Stack;\r
3125   Result := False;\r
3126   if ToolServices <> nil then\r
3127   try\r
3128     //Rpt( 'trying to save to IDE Editor: ' + Path );\r
3129 \r
3130     N := ToolServices.GetUnitCount;\r
3131     for I := 0 to N - 1 do\r
3132     begin\r
3133       S := ToolServices.GetUnitName( I );\r
3134       if AnsiLowerCase( S ) = AnsiLowerCase( Path ) then\r
3135       begin\r
3136         //Rpt( 'Updating in IDE: ' + Path );\r
3137         // unit is loaded into IDE editor - make an attempt to update it from there\r
3138         Module := ToolServices.GetModuleInterface( S );\r
3139         if Module <> nil then\r
3140         try\r
3141           Editor := Module.GetEditorInterface;\r
3142           if Editor <> nil then\r
3143           try\r
3144             Writer := Editor.CreateWriter;\r
3145             Buffer := SL.Text;\r
3146             if Writer <> nil then\r
3147             try\r
3148               //Rpt( 'Updating source in IDE Editor: ' + Path );\r
3149               if Writer.DeleteTo( $3FFFFFFF ) and Writer.Insert( PChar( Buffer ) ) then\r
3150                 Result := True;\r
3151               //else Rpt( 'Can not update ' + S );\r
3152             finally\r
3153               Writer.Free;\r
3154             end;\r
3155           finally\r
3156             Editor.Free;\r
3157           end;\r
3158         finally\r
3159           Module.Free;\r
3160         end;\r
3161         break;\r
3162       end;\r
3163     end;\r
3164 \r
3165     {$IFNDEF VER90}\r
3166     {$IFNDEF VER100}\r
3167     if not Result and (BorlandIDEServices <> nil) then\r
3168     begin\r
3169       if BorlandIDEServices.QueryInterface( IOTAModuleServices, MS ) = 0 then\r
3170       begin\r
3171         M := MS.FindModule( Path );\r
3172         if M <> nil then\r
3173         begin\r
3174           N := M.GetModuleFileCount;\r
3175           for I := 0 to N-1 do\r
3176           begin\r
3177             E := M.GetModuleFileEditor( I );\r
3178             if E.QueryInterface( IOTASourceEditor, SE ) = 0 then\r
3179             begin\r
3180               {$IFNDEF VER120}\r
3181               if E.QueryInterface( IOTAEditBuffer, EB ) = 0 then\r
3182               begin\r
3183                 RO := EB.IsReadOnly;\r
3184                 if RO then\r
3185                   EB.IsReadOnly := FALSE;\r
3186               end;\r
3187               {$ENDIF}\r
3188               EW := SE.CreateWriter;\r
3189               if EW <> nil then\r
3190               begin\r
3191                 Buffer := SL.Text;\r
3192                 EW.DeleteTo( $3FFFFFFF );\r
3193                 EW.Insert( PChar( Buffer ) );\r
3194                 Result := True;\r
3195                 break;\r
3196               end;\r
3197             end;\r
3198           end;\r
3199         end;\r
3200       end;\r
3201     end;\r
3202     {$ENDIF}\r
3203     {$ENDIF}\r
3204 \r
3205   except\r
3206     on E: Exception do\r
3207     begin\r
3208       ShowMessage( 'Can not update source, exception: ' + E.Message );\r
3209     end;\r
3210   end;\r
3211 \r
3212 end;\r
3213 \r
3214 procedure SaveStrings( SL: TStrings; const Path: String; var Updated: Boolean );\r
3215 var S1: String;\r
3216     Old: TStringList;\r
3217     I: Integer;\r
3218     TheSame: Boolean;\r
3219     OldCount, NewCount: Integer;\r
3220 begin\r
3221   asm\r
3222     jmp @@e_signature\r
3223     DB '#$signature$#', 0\r
3224     DB 'SaveStrings', 0\r
3225   @@e_signature:\r
3226   end;\r
3227   //Rpt( 'SaveStrings: ' + Path );\r
3228   Old := TStringList.Create;\r
3229   LoadSource( Old, Path );\r
3230 \r
3231   TheSame := FALSE;\r
3232   if Old.Count > 0 then\r
3233   begin\r
3234     OldCount := Old.Count;\r
3235     while (OldCount > 1) and (Trim(Old[ OldCount - 1 ]) = '') do\r
3236       Dec( OldCount );\r
3237     NewCount := SL.Count;\r
3238     while (NewCount > 1) and (Trim(SL[ NewCount - 1]) = '') do\r
3239       Dec( NewCount );\r
3240     TheSame := OldCount = NewCount;\r
3241     if TheSame then\r
3242     for I := 0 to OldCount - 1 do\r
3243       if Old[ I ] <> SL[ I ] then\r
3244       begin\r
3245         TheSame := False;\r
3246         break;\r
3247       end;\r
3248     Old.Free;\r
3249   end;\r
3250   if not TheSame then\r
3251   begin\r
3252     Rpt( 'SaveStrings: found that strings are different' ); //Rpt_Stack;\r
3253 \r
3254     if UpdateSource( SL, Path ) then\r
3255     begin\r
3256       //Rpt( 'updated (in IDE Editor): ' + Path );\r
3257       if FileExists( Path ) then\r
3258         SetFileAttributes( PChar( Path ), FILE_ATTRIBUTE_NORMAL );\r
3259       Updated := TRUE;\r
3260       Exit;\r
3261     end;\r
3262 \r
3263     //Rpt( 'writing to ' + Path );\r
3264     S1 := Copy( Path, 1, Length( Path ) - 3 ) + '$$$';\r
3265     if FileExists( S1 ) then\r
3266       DeleteFile( S1 );\r
3267     SetFileAttributes( PChar( Path ), FILE_ATTRIBUTE_NORMAL );\r
3268     MoveFile( PChar( Path ), PChar( S1 ) );\r
3269     if KOLProject <> nil then\r
3270     begin\r
3271       S1 := KOLProject.OutdcuPath + ExtractFileName( Path );\r
3272       if LowerCase( Copy( S1, Length( S1 ) - 3, 4 ) ) = '.inc' then\r
3273         S1 := Copy( S1, 1, Length( S1 ) - 6 ) + '.dcu'\r
3274       else\r
3275         S1 := Copy( S1, 1, Length( S1 ) - 3 ) + 'dcu';\r
3276       if FileExists( S1 ) then\r
3277       begin\r
3278         //Rpt( 'Remove: ' + S1 );\r
3279         DeleteFile( S1 );\r
3280       end;\r
3281     end;\r
3282     SL.SaveToFile( Path );\r
3283     Updated := TRUE;\r
3284     {if Protect then\r
3285       SetFileAttributes( PChar( Path ), FILE_ATTRIBUTE_READONLY );}\r
3286   end\r
3287      else\r
3288   begin\r
3289     //Rpt( 'file ' + Path + ' is the same.' );\r
3290     Exit;\r
3291   end;\r
3292 end;\r
3293 \r
3294 procedure SaveStringToFile(const Path, Str: String );\r
3295 var SL: TStringList;\r
3296 begin\r
3297   SL := TStringList.Create;\r
3298   TRY\r
3299   SL.Text := Str;\r
3300   SL.SaveToFile( Path );\r
3301   FINALLY\r
3302   SL.Free;\r
3303   END;\r
3304 end;\r
3305 \r
3306 procedure MarkModified( const Path: String );\r
3307 {$IFNDEF VER90}\r
3308 {$IFNDEF VER100}\r
3309 var MS: IOTAModuleServices;\r
3310     M: IOTAModule;\r
3311     E: IOTAEditor;\r
3312     I, N: Integer;\r
3313 {$ENDIF}\r
3314 {$ENDIF}\r
3315 begin\r
3316   asm\r
3317     jmp @@e_signature\r
3318     DB '#$signature$#', 0\r
3319     DB 'MarkModified', 0\r
3320   @@e_signature:\r
3321   end;\r
3322   Rpt( 'MarkModified: ' + Path ); //Rpt_Stack;\r
3323 {$IFNDEF VER90}\r
3324 {$IFNDEF VER100}\r
3325   if (BorlandIDEServices <> nil) and\r
3326      (BorlandIDEServices.QueryInterface( IOTAModuleServices, MS ) = 0) then\r
3327   begin\r
3328     M := MS.FindModule( Path );\r
3329     if M <> nil then\r
3330     begin\r
3331       N := M.GetModuleFileCount;\r
3332       for I := 0 to N-1 do\r
3333       begin\r
3334         E := M.GetModuleFileEditor( I );\r
3335         if E <> nil then\r
3336         begin\r
3337           E.MarkModified;\r
3338           break;\r
3339         end;\r
3340       end;\r
3341     end;\r
3342   end;\r
3343 {$ENDIF}\r
3344 {$ENDIF}\r
3345 end;\r
3346 \r
3347 procedure UpdateUnit( const Path: String );\r
3348 var MI: TIModuleInterface;\r
3349 begin\r
3350   asm\r
3351     jmp @@e_signature\r
3352     DB '#$signature$#', 0\r
3353     DB 'UpdateUnit', 0\r
3354   @@e_signature:\r
3355   end;\r
3356   if ToolServices = nil then Exit;\r
3357   MI := ToolServices.GetModuleInterface( Path );\r
3358   if MI <> nil then\r
3359   TRY\r
3360     Rpt( 'Update Unit: ' + Path ); //Rpt_Stack;\r
3361     MI.Save( TRUE );\r
3362   FINALLY\r
3363     MI.Free;\r
3364   END;\r
3365 end;\r
3366 \r
3367 procedure AddLongTextField( var SL: TStringList; const Prefix:String;\r
3368  const Text:String; const Suffix:String );\r
3369 var //s:String;\r
3370     i,k,n:Integer;\r
3371 const LIMIT = 80;\r
3372 begin\r
3373   asm\r
3374     jmp @@e_signature\r
3375     DB '#$signature$#', 0\r
3376     DB 'AddLongTextField', 0\r
3377   @@e_signature:\r
3378   end;\r
3379      if ( Length( Text ) > LIMIT ) then\r
3380      begin\r
3381           SL.Add( Prefix + '''''' );\r
3382 \r
3383           k := Length( Text );\r
3384           i := 0;\r
3385           while ( i <> k ) do\r
3386           begin\r
3387                inc(i);\r
3388                n := ( i mod LIMIT );\r
3389                if ( ( n = LIMIT - 1 ) or ( i = k ) ) then\r
3390                begin\r
3391                     SL.Add( ' + ' + String2Pascal( Copy( Text, i + 1 - n, n + 1 ) ) );\r
3392                end;\r
3393           end;\r
3394 \r
3395           SL.Add( Suffix );\r
3396      end\r
3397      else\r
3398      begin\r
3399           SL.Add( Prefix + String2Pascal(Text) + Suffix );\r
3400      end;\r
3401 end;\r
3402 \r
3403 \r
3404 \r
3405 \r
3406 \r
3407 \r
3408 {YS}//--------------------------------------------------------------\r
3409 \r
3410 {$IFNDEF NOT_USE_KOLCTRLWRAPPER}\r
3411 function InterceptWndProc( W: HWnd; Msg: Cardinal; wParam, lParam: Integer ): Integer; stdcall;\r
3412 var\r
3413   KOLParentCtrl: PControl;\r
3414   _Msg: TMsg;\r
3415   OldWndProc: pointer;\r
3416 \r
3417 begin\r
3418   KOLParentCtrl:=PControl(GetProp(W, 'KOLParentCtrl'));\r
3419   OldWndProc:=pointer(GetProp(W, 'OldWndProc'));\r
3420 \r
3421   if Assigned(KOLParentCtrl) and KOLParentCtrl.HandleAllocated then\r
3422       if (Msg in [WM_DRAWITEM, WM_NOTIFY, WM_SIZE, WM_MEASUREITEM]) then begin\r
3423         _Msg.hwnd:=KOLParentCtrl.Handle;\r
3424         _Msg.message:=Msg;\r
3425         _Msg.wParam:=WParam;\r
3426         _Msg.lParam:=LParam;\r
3427         KOLParentCtrl.WndProc(_Msg);\r
3428       end;\r
3429 \r
3430   Result:=CallWindowProc(OldWndProc, W, Msg, wParam, lParam);\r
3431 end;\r
3432 \r
3433 function EnumChildProc(wnd: HWND; lParam: integer): BOOL; stdcall;\r
3434 begin\r
3435   ShowWindow(wnd, lParam);\r
3436   Result:=True;\r
3437 end;\r
3438 \r
3439 { TKOLVCLParent }\r
3440 \r
3441 function NewKOLVCLParent: PKOLVCLParent;\r
3442 begin\r
3443   New( Result, CreateParented( nil ) );\r
3444   Result.fControlClassName := 'KOLVCLParent';\r
3445   Result.Visible:=False;\r
3446 end;\r
3447 {$ENDIF NOT_USE_KOLCTRLWRAPPER}\r
3448 \r
3449 procedure TKOLVCLParent.AttachHandle(AHandle: HWND);\r
3450 begin\r
3451   fHandle:=AHandle;\r
3452 end;\r
3453 \r
3454 procedure TKOLVCLParent.AssignDynHandlers(Src: PKOLVCLParent);\r
3455 var\r
3456   i: integer;\r
3457 \r
3458 begin\r
3459   i:=0;\r
3460   while i < Src.fDynHandlers.Count do begin\r
3461     AttachProcEx(Src.fDynHandlers.Items[i], boolean(Src.fDynHandlers.Items[i + 1]));\r
3462     Inc(i, 2);\r
3463   end;\r
3464 end;\r
3465 \r
3466 {$IFNDEF NOT_USE_KOLCTRLWRAPPER}\r
3467 { TKOLCtrlWrapper }\r
3468 \r
3469 constructor TKOLCtrlWrapper.Create(AOwner: TComponent);\r
3470 begin\r
3471   inherited;\r
3472   FAllowSelfPaint:=True;\r
3473 {$IFDEF _KOLCtrlWrapper_}\r
3474   CreateKOLControl(False);\r
3475 {$ENDIF}\r
3476 end;\r
3477 \r
3478 destructor TKOLCtrlWrapper.Destroy;\r
3479 begin\r
3480   if Assigned(FKOLCtrl) then begin\r
3481     Parent:=nil;\r
3482     if Assigned(FKOLCtrl) and (FKOLCtrl.Parent <> nil) and not FRealParent then begin\r
3483       FKOLParentCtrl.RefDec;\r
3484       RemoveParentAttach;\r
3485     end;\r
3486   end;\r
3487   inherited;\r
3488   if not FRealParent and Assigned(FKOLParentCtrl) and (FKOLParentCtrl.RefCount = 0) then\r
3489     FKOLParentCtrl.Free;\r
3490 end;\r
3491 \r
3492 procedure TKOLCtrlWrapper.RemoveParentAttach;\r
3493 var\r
3494   wp: integer;\r
3495 begin\r
3496   if not FRealParent and (FKOLParentCtrl.RefCount <= 1) and FKOLParentCtrl.HandleAllocated then begin\r
3497     wp:=GetProp(FKOLParentCtrl.Handle, 'OldWndProc');\r
3498     if wp <> 0 then\r
3499       SetWindowLong(FKOLParentCtrl.Handle, GWL_WNDPROC, wp);\r
3500     RemoveProp(FKOLParentCtrl.Handle, 'KOLParentCtrl');\r
3501     RemoveProp(FKOLParentCtrl.Handle, 'OldWndProc');\r
3502     FKOLParentCtrl.AttachHandle(0);\r
3503   end;\r
3504 end;\r
3505 \r
3506 procedure TKOLCtrlWrapper.SetParent(Value: TWinControl);\r
3507 var\r
3508   KP: PKOLVCLParent;\r
3509 \r
3510   procedure AssignNewParent;\r
3511   begin\r
3512     KP.AssignDynHandlers(FKOLParentCtrl);\r
3513     FKOLCtrl.Parent:=KP;\r
3514     Windows.SetParent(FKOLCtrl.Handle, Value.Handle);\r
3515     if not FRealParent then\r
3516       FKOLParentCtrl.Free;\r
3517     FKOLParentCtrl:=KP;\r
3518   end;\r
3519 \r
3520 var\r
3521   F: TCustomForm;\r
3522 \r
3523 begin\r
3524   if Assigned(FKOLCtrl) and (Parent <> Value) then begin\r
3525     if Assigned(Parent) then begin\r
3526       FKOLCtrl.Parent:=nil;\r
3527       if not FRealParent then begin\r
3528         FKOLParentCtrl.RefDec;\r
3529         RemoveParentAttach;\r
3530       end;\r
3531     end;\r
3532     if Assigned(Value) then begin\r
3533       if (Value is TKOLCtrlWrapper) and Assigned(TKOLCtrlWrapper(Value).FKOLCtrl) then\r
3534         KP:=PKOLVCLParent(TKOLCtrlWrapper(Value).FKOLCtrl)\r
3535       else\r
3536         KP:=PKOLVCLParent(GetProp(Value.Handle, 'KOLParentCtrl'));\r
3537       if Assigned(KP) then begin\r
3538         AssignNewParent;\r
3539         FRealParent:=(Value is TKOLCtrlWrapper) and Assigned(TKOLCtrlWrapper(Value).FKOLCtrl);\r
3540       end\r
3541       else begin\r
3542         FRealParent:=False;\r
3543         if FKOLParentCtrl.HandleAllocated then begin\r
3544           KP:=NewKOLVCLParent;\r
3545           AssignNewParent;\r
3546         end;\r
3547         FKOLParentCtrl.AttachHandle(Value.Handle);\r
3548         SetProp(Value.Handle, 'KOLParentCtrl', integer(FKOLParentCtrl));\r
3549         SetProp(Value.Handle, 'OldWndProc', GetWindowLong(Value.Handle, GWL_WNDPROC));\r
3550         SetWindowLong(Value.Handle, GWL_WNDPROC, integer(@InterceptWndProc));\r
3551       end;\r
3552       if not FRealParent then\r
3553         FKOLParentCtrl.RefInc;\r
3554       FKOLCtrl.Style:=FKOLCtrl.Style or WS_CLIPSIBLINGS;\r
3555     end;\r
3556   end;\r
3557   inherited;\r
3558   if Assigned(FKOLCtrl) and Assigned(Value) then begin\r
3559     HandleNeeded;\r
3560     F:=GetParentForm(Self);\r
3561     if Assigned(F) then\r
3562       Windows.SetFocus(F.Handle);\r
3563     UpdateAllowSelfPaint;\r
3564   end;\r
3565 end;\r
3566 \r
3567 procedure TKOLCtrlWrapper.WndProc(var Message: TMessage);\r
3568 var\r
3569   DeniedMessage: boolean;\r
3570   DC: HDC;\r
3571   PS: TPaintStruct;\r
3572 begin\r
3573   if Assigned(FKOLCtrl) then begin\r
3574     DeniedMessage:=(((Message.Msg >= WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST)) or\r
3575        ((Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST)) or\r
3576        (Message.Msg in [WM_NCHITTEST, WM_SETCURSOR]) or\r
3577        (Message.Msg = CM_DESIGNHITTEST)\r
3578        {$IFDEF _D3orHigher} or (Message.Msg = CM_RECREATEWND) {$ENDIF}\r
3579        );\r
3580 \r
3581     if not FAllowSelfPaint and (Message.Msg in [WM_NCCALCSIZE, WM_ERASEBKGND]) then\r
3582       exit;\r
3583 \r
3584     if FAllowSelfPaint or (Message.Msg <> WM_PAINT) then\r
3585       if not DeniedMessage then\r
3586         CallKOLCtrlWndProc(Message);\r
3587 \r
3588     if (FKOLCtrl.Parent = nil) and (Message.Msg = WM_NCDESTROY) then begin\r
3589       FKOLCtrl:=nil;\r
3590       if not FRealParent and Assigned(FKOLParentCtrl) and (FKOLParentCtrl.RefCount = 0) then begin\r
3591         FKOLParentCtrl.Free;\r
3592         FKOLParentCtrl:=nil;\r
3593       end;\r
3594       exit;\r
3595     end;\r
3596 \r
3597     if not (DeniedMessage or\r
3598             (Message.Msg in [WM_PAINT, WM_SIZE, WM_MOVE, WM_WINDOWPOSCHANGED, WM_WINDOWPOSCHANGING, WM_DESTROY]))\r
3599     then\r
3600       exit;\r
3601 \r
3602     if (Message.Msg = WM_PAINT) then begin\r
3603       if FAllowSelfPaint then\r
3604         DC:=GetDC(WindowHandle)\r
3605       else\r
3606         DC:=BeginPaint(WindowHandle, PS);\r
3607       try\r
3608         Message.WParam:=DC;\r
3609         inherited;\r
3610       finally\r
3611         if FAllowSelfPaint then\r
3612           ReleaseDC( WindowHandle, DC )\r
3613         else\r
3614           EndPaint(WindowHandle, PS);\r
3615       end;\r
3616       exit;\r
3617     end;\r
3618 \r
3619   end;\r
3620   inherited;\r
3621   if {$IFDEF _D3orHigher} (Message.Msg = CM_RECREATEWND) and {$ENDIF}\r
3622      FKOLCtrlNeeded then\r
3623     HandleNeeded;\r
3624 end;\r
3625 \r
3626 procedure TKOLCtrlWrapper.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);\r
3627 var R: TRect;\r
3628 begin\r
3629   Log( '->TKOLCtrlWrapper.SetBounds' );\r
3630   try\r
3631     TRY\r
3632     //Log( 'TKOLCtrlWrapper.SetBounds-1' );\r
3633     //if not( csLoading in ComponentState ) then\r
3634     begin\r
3635       //Log( 'TKOLCtrlWrapper.SetBounds-1A - very often crashed here on loading project' );\r
3636       //Rpt_Stack;\r
3637       inherited SetBounds( ALeft, ATop, AWidth, AHeight );\r
3638       //Log( 'TKOLCtrlWrapper.SetBounds-1B' );\r
3639       R := BoundsRect;\r
3640       //Log( 'TKOLCtrlWrapper.SetBounds-1C' );\r
3641     end\r
3642       {else\r
3643     begin\r
3644       //Log( 'TKOLCtrlWrapper.SetBounds-1D' );\r
3645       R := Rect( ALeft, ATop, ALeft+AWidth, ATop+AHeight  );\r
3646       //Log( 'TKOLCtrlWrapper.SetBounds-1E' );\r
3647     end};\r
3648     //Log( 'TKOLCtrlWrapper.SetBounds-2' );\r
3649     if Assigned(FKOLCtrl) then\r
3650     begin\r
3651       //Log( 'TKOLCtrlWrapper.SetBounds-3' );\r
3652       if FKOLCtrl <> nil then\r
3653       begin\r
3654         //Log( 'TKOLCtrlWrapper.SetBounds-3A' );\r
3655         //Log( 'FKOLCtrl.Handle = ' + Int2Str( FKOLCtrl.Handle ) );\r
3656         //Log( 'FKOLCtrl.Parent = ' + Int2Str( DWORD( FKOLCtrl.Parent ) ) );\r
3657         FKOLCtrl.BoundsRect := R;\r
3658         //Log( 'TKOLCtrlWrapper.SetBounds-3B' );\r
3659       end;\r
3660       //Log( 'TKOLCtrlWrapper.SetBounds-4' );\r
3661       if not FAllowSelfPaint and HandleAllocated then\r
3662       begin\r
3663         //Log( 'TKOLCtrlWrapper.SetBounds-5' );\r
3664         UpdateAllowSelfPaint;\r
3665         //Log( 'TKOLCtrlWrapper.SetBounds-6' );\r
3666       end;\r
3667       //Log( 'TKOLCtrlWrapper.SetBounds-7' );\r
3668     end;\r
3669     EXCEPT\r
3670       on E: EXception do\r
3671         Rpt( 'Exception in TKOLCtrlWrapper.SetBounds: ' + E.Message );\r
3672     END;\r
3673   LogOK;\r
3674   finally\r
3675   Log( '<-TKOLCtrlWrapper.SetBounds' );\r
3676   end;\r
3677 end;\r
3678 \r
3679 procedure TKOLCtrlWrapper.CreateWnd;\r
3680 begin\r
3681   if not Assigned(FKOLCtrl) and FKOLCtrlNeeded then begin\r
3682     CreateKOLControl(True);\r
3683     if Assigned(FKOLCtrl) then\r
3684       FKOLCtrl.BoundsRect:=BoundsRect;\r
3685   end;\r
3686   if Assigned(FKOLCtrl) then begin\r
3687     WindowHandle:=FKOLCtrl.GetWindowHandle;\r
3688     CreationControl:=Self;\r
3689     InitWndProc(WindowHandle, 0, 0, 0);\r
3690     if FKOLCtrlNeeded then\r
3691       KOLControlRecreated;\r
3692     FKOLCtrlNeeded:=False;\r
3693     UpdateAllowSelfPaint;\r
3694     FKOLCtrl.Visible:=True;\r
3695   end\r
3696   else\r
3697     inherited;\r
3698 end;\r
3699 \r
3700 procedure TKOLCtrlWrapper.DestroyWindowHandle;\r
3701 var\r
3702   i: integer;\r
3703 begin\r
3704   if Assigned(FKOLCtrl) then begin\r
3705     WindowHandle:=0;\r
3706     while FKOLCtrl.ChildCount > 0 do\r
3707       FKOLCtrl.Children[0].Parent:=nil;\r
3708     {$IFDEF _D4orHigher}\r
3709     ControlState:=ControlState + [csDestroyingHandle];\r
3710     {$ENDIF}\r
3711     try\r
3712       FKOLCtrl.Free;\r
3713     finally\r
3714       {$IFDEF _D4orHigher}\r
3715       ControlState:=ControlState - [csDestroyingHandle];\r
3716       {$ENDIF}\r
3717     end;\r
3718     FKOLCtrl:=nil;\r
3719     if not (csDestroying in ComponentState) then begin\r
3720       for i:=0 to ControlCount - 1 do\r
3721         if Controls[i] is TKOLCtrlWrapper then\r
3722           with TKOLCtrlWrapper(Controls[i]) do begin\r
3723             FKOLParentCtrl:=nil;\r
3724           end;\r
3725     end;\r
3726     FKOLCtrlNeeded:=True;\r
3727   end\r
3728   else\r
3729     inherited;\r
3730 end;\r
3731 \r
3732 procedure TKOLCtrlWrapper.DefaultHandler(var Message);\r
3733 begin\r
3734   if Assigned(FKOLCtrl) then begin\r
3735     if AllowSelfPaint and not (TMessage(Message).Msg in [WM_PAINT, WM_SETCURSOR, WM_DESTROY]) then\r
3736       CallKOLCtrlWndProc(TMessage(Message));\r
3737   end\r
3738   else\r
3739     inherited;\r
3740 end;\r
3741 \r
3742 procedure TKOLCtrlWrapper.CallKOLCtrlWndProc(var Message: TMessage);\r
3743 var\r
3744   _Msg: TMsg;\r
3745 begin\r
3746   _Msg.hwnd:=FKOLCtrl.Handle;\r
3747   _Msg.message:=Message.Msg;\r
3748   _Msg.wParam:=Message.wParam;\r
3749   _Msg.lParam:=Message.lParam;\r
3750   Message.Result:=FKOLCtrl.WndProc(_Msg);\r
3751 end;\r
3752 \r
3753 procedure TKOLCtrlWrapper.Invalidate;\r
3754 begin\r
3755   if not Assigned(FKOLCtrl) then\r
3756     inherited\r
3757   else\r
3758   begin\r
3759     if HandleAllocated then\r
3760     begin\r
3761       InvalidateRect(WindowHandle, nil, not (csOpaque in ControlStyle))\r
3762     end;\r
3763     FKOLCtrl.Invalidate;\r
3764   end;\r
3765 end;\r
3766 \r
3767 procedure TKOLCtrlWrapper.SetAllowSelfPaint(const Value: boolean);\r
3768 begin\r
3769   if FAllowSelfPaint = Value then exit;\r
3770   FAllowSelfPaint := Value;\r
3771   UpdateAllowSelfPaint;\r
3772 end;\r
3773 \r
3774 procedure TKOLCtrlWrapper.UpdateAllowSelfPaint;\r
3775 var\r
3776   i: integer;\r
3777 \r
3778 begin\r
3779   if Assigned(FKOLCtrl) and HandleAllocated then begin\r
3780     if not (csAcceptsControls in ControlStyle) then begin\r
3781       if FAllowSelfPaint then\r
3782         i:=SW_SHOW\r
3783       else\r
3784         i:=SW_HIDE;\r
3785       EnumChildWindows(WindowHandle, @EnumChildProc, i);\r
3786     end;\r
3787     SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_DRAWFRAME or SWP_FRAMECHANGED or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);\r
3788     Invalidate;\r
3789   end;\r
3790 end;\r
3791 \r
3792 function TKOLCtrlWrapper.GetKOLParentCtrl: PControl;\r
3793 begin\r
3794   if (FKOLParentCtrl = nil) and (FKOLCtrl = nil) then begin\r
3795     if Assigned(Parent) and (Parent is TKOLCtrlWrapper) and Assigned(TKOLCtrlWrapper(Parent).FKOLCtrl) then\r
3796       FKOLParentCtrl:=PKOLVCLParent(TKOLCtrlWrapper(Parent).FKOLCtrl)\r
3797     else\r
3798       FKOLParentCtrl:=NewKOLVCLParent;\r
3799   end;\r
3800   Result:=FKOLParentCtrl;\r
3801 end;\r
3802 \r
3803 procedure TKOLCtrlWrapper.PaintWindow(DC: HDC);\r
3804 begin\r
3805   if Assigned(FKOLCtrl) and not FAllowCustomPaint and not FAllowPostPaint then\r
3806     exit;\r
3807   inherited;\r
3808 end;\r
3809 \r
3810 procedure TKOLCtrlWrapper.CreateKOLControl(Recreating: boolean);\r
3811 begin\r
3812 end;\r
3813 \r
3814 procedure TKOLCtrlWrapper.KOLControlRecreated;\r
3815 begin\r
3816 end;\r
3817 \r
3818 procedure TKOLCtrlWrapper.DestroyWnd;\r
3819 begin\r
3820   inherited;\r
3821   if FKOLCtrlNeeded then begin\r
3822     StrDispose(WindowText);\r
3823     WindowText:=nil;\r
3824   end;\r
3825 end;\r
3826 {$ENDIF NOT_USE_KOLCTRLWRAPPER}\r
3827 \r
3828 procedure TKOLCtrlWrapper.Change;\r
3829 begin\r
3830   Log( '->TKOLCtrlWrapper.Change' );\r
3831   TRY\r
3832   LogOK;\r
3833   FINALLY\r
3834   Log( '<-TKOLCtrlWrapper.Change' );\r
3835   END;\r
3836 end;\r
3837 \r
3838 { TKOLCustomControl }\r
3839 \r
3840 function TKOLCustomControl.AdditionalUnits: String;\r
3841 begin\r
3842   asm\r
3843     jmp @@e_signature\r
3844     DB '#$signature$#', 0\r
3845     DB 'TKOLCustomControl.AdditionalUnits', 0\r
3846   @@e_signature:\r
3847   end;\r
3848   Result := '';\r
3849 end;\r
3850 \r
3851 procedure TKOLCustomControl.ApplyColorToChildren;\r
3852 var I: Integer;\r
3853     C: TKOLCustomControl;\r
3854 begin\r
3855   asm\r
3856     jmp @@e_signature\r
3857     DB '#$signature$#', 0\r
3858     DB 'TKOLCustomControl.ApplyFontToChildren', 0\r
3859   @@e_signature:\r
3860   end;\r
3861   Log( '->TKOLCustomControl.ApplyColorToChildren' );\r
3862   try\r
3863   for I := 0 to FParentLikeColorControls.Count - 1 do\r
3864   begin\r
3865     C := FParentLikeColorControls[ I ];\r
3866     C.Color := Color;\r
3867   end;\r
3868   LogOK;\r
3869   finally\r
3870   Log( '<-TKOLCustomControl.ApplyColorToChildren' );\r
3871   end;\r
3872 end;\r
3873 \r
3874 procedure TKOLCustomControl.ApplyFontToChildren;\r
3875 var I: Integer;\r
3876     C: TKOLCustomControl;\r
3877 begin\r
3878   asm\r
3879     jmp @@e_signature\r
3880     DB '#$signature$#', 0\r
3881     DB 'TKOLCustomControl.ApplyFontToChildren', 0\r
3882   @@e_signature:\r
3883   end;\r
3884   Log( '->TKOLCustomControl.ApplyFontToChildren' );\r
3885   try\r
3886   if AutoSize then\r
3887     AutoSizeNow;\r
3888   for I := 0 to FParentLikeFontControls.Count - 1 do\r
3889   begin\r
3890     C := FParentLikeFontControls[ I ];\r
3891     C.Font.Assign( Font );\r
3892   end;\r
3893   LogOK;\r
3894   finally\r
3895   Log( '<-TKOLCustomControl.ApplyFontToChildren' );\r
3896   end;\r
3897 end;\r
3898 \r
3899 procedure TKOLCustomControl.AssignEvents(SL: TStringList; const AName: String);\r
3900 begin\r
3901   asm\r
3902     jmp @@e_signature\r
3903     DB '#$signature$#', 0\r
3904     DB 'TKOLCustomControl.AssignEvents', 0\r
3905   @@e_signature:\r
3906   end;\r
3907   Log( '->TKOLCustomControl.AssignEvents' );\r
3908   try\r
3909   DoAssignEvents( SL, AName,\r
3910   [ 'OnClick', 'OnMouseDblClk', 'OnMessage', 'OnMouseDown', 'OnMouseMove', 'OnMouseUp', 'OnMouseWheel', 'OnMouseEnter', 'OnMouseLeave' ],\r
3911   [ @OnClick, @ OnMouseDblClk,  @OnMessage,  @OnMouseDown,  @OnMouseMove,  @OnMouseUp,  @OnMouseWheel,  @OnMouseEnter,  @OnMouseLeave  ] );\r
3912   DoAssignEvents( SL, AName,\r
3913   [ 'OnDestroy', 'OnEnter', 'OnLeave', 'OnKeyDown', 'OnKeyUp', 'OnChar' ],\r
3914   [ @ OnDestroy, @OnEnter,  @OnLeave,  @OnKeyDown,  @OnKeyUp,  @OnChar  ] );\r
3915   DoAssignEvents( SL, AName,\r
3916   [ 'OnChange', 'OnSelChange', 'OnPaint', 'OnEraseBkgnd', 'OnResize', 'OnMove', 'OnBitBtnDraw', 'OnDropDown', 'OnCloseUp', 'OnProgress' ],\r
3917   [ @OnChange,  @OnSelChange,  @OnPaint , @ OnEraseBkgnd, @OnResize,  @ OnMove, @OnBitBtnDraw,  @OnDropDown, @ OnCloseUp,  @ OnProgress  ] );\r
3918   DoAssignEvents( SL, AName,\r
3919   [ 'OnDeleteAllLVItems', 'OnDeleteLVItem', 'OnLVData', 'OnCompareLVItems', 'OnColumnClick', 'OnLVStateChange', 'OnEndEditLVItem' ],\r
3920   [ @ OnDeleteAllLVItems, @ OnDeleteLVItem, @ OnLVData, @ OnCompareLVItems, @ OnColumnClick, @ OnLVStateChange, @ OnEndEditLVItem ] );\r
3921   DoAssignEvents( SL, AName,\r
3922   [ 'OnDrawItem', 'OnMeasureItem', 'OnTBDropDown', 'OnDropFiles', 'OnShow', 'OnHide', 'OnSplit', 'OnScroll' ],\r
3923   [ @ OnDrawItem, @ OnMeasureItem, @ OnTBDropDown, @ OnDropFiles, @ OnShow, @ OnHide, @ OnSplit, @ OnScroll ] );\r
3924   DoAssignEvents( SL, AName,\r
3925   [ 'OnRE_URLClick', 'OnRE_InsOvrMode_Change', 'OnRE_OverURL' ],\r
3926   [ @ OnRE_URLClick, @ OnRE_InsOvrMode_Change, @ OnRE_OverURL ] );\r
3927   DoAssignEvents( SL, AName,\r
3928   [ 'OnTVBeginDrag', 'OnTVBeginEdit', 'OnTVEndEdit', 'OnTVExpanded', 'OnTVExpanding', 'OnTVSelChanging', 'OnTVDelete' ],\r
3929   [ @ OnTVBeginDrag, @ OnTVBeginEdit, @ OnTVEndEdit, @ OnTVExpanded, @ OnTVExpanding, @ OnTVSelChanging, @ OnTVDelete ] );\r
3930   LogOK;\r
3931   finally\r
3932   Log( '<-TKOLCustomControl.AssignEvents' );\r
3933   end;\r
3934 end;\r
3935 \r
3936 function TKOLCustomControl.AutoHeight(Canvas: TCanvas): Integer;\r
3937 var Txt: String;\r
3938     Sz: TSize;\r
3939 begin\r
3940   asm\r
3941     jmp @@e_signature\r
3942     DB '#$signature$#', 0\r
3943     DB 'TKOLCustomControl.AutoHeight', 0\r
3944   @@e_signature:\r
3945   end;\r
3946   Log( '->TKOLCustomControl.AutoHeight' );\r
3947   try\r
3948   if Caption <> '' then\r
3949     Txt := Caption\r
3950   else\r
3951     Txt := 'Ap^_/|';\r
3952   Windows.GetTextExtentPoint32( Canvas.Handle, PChar( Txt ), Length( Txt ),\r
3953                                 Sz );\r
3954   Result := Sz.cy;\r
3955   LogOK;\r
3956   finally\r
3957   Log( '<-TKOLCustomControl.AutoHeight' );\r
3958   end;\r
3959 end;\r
3960 \r
3961 procedure TKOLCustomControl.AutoSizeNow;\r
3962 var TmpBmp: graphics.TBitmap;\r
3963     W, H: Integer;\r
3964 begin\r
3965   asm\r
3966     jmp @@e_signature\r
3967     DB '#$signature$#', 0\r
3968     DB 'AutoSizeNow', 0\r
3969   @@e_signature:\r
3970   end;\r
3971   Log( '->TKOLCustomControl.AutoSizeNow' );\r
3972   try\r
3973 \r
3974   if fAutoSizingNow or (csLoading in ComponentState) then\r
3975   begin\r
3976     LogOK; Exit;\r
3977   end;\r
3978   fAutoSizingNow := TRUE;\r
3979   Rpt( 'Autosize, Name: ' + Name );\r
3980   TmpBmp := graphics.TBitmap.Create;\r
3981   try\r
3982     TmpBmp.Width := 10;\r
3983     TmpBmp.Height := 10;\r
3984     Rpt( 'Autosize, Prepare Font for WYSIWIG Paint' );\r
3985     PrepareCanvasFontForWYSIWIGPaint( TmpBmp.Canvas );\r
3986     Rpt( 'Name=' + Name + ': Canvas.Handle := ' + Int2Hex( TmpBmp.Canvas.Handle, 8 ) );\r
3987     W := AutoWidth( TmpBmp.Canvas );\r
3988     H := AutoHeight( TmpBmp.Canvas );\r
3989     Rpt( 'Name=' + Name + ': Canvas.Handle := ' + Int2Hex( TmpBmp.Canvas.Handle, 8 ) );\r
3990     Rpt( 'Name=' + Name + ': W=' + IntToStr( W ) + ' H=' + IntToStr( H ) );\r
3991     if Align in [ caNone, caLeft, caRight ] then\r
3992     if not fNoAutoSizeX then\r
3993       Width := W + fAutoSzX;\r
3994     if Align in [ caNone, caTop, caBottom ] then\r
3995       Height := H + fAutoSzY;\r
3996   finally\r
3997     TmpBmp.Free;\r
3998     fAutoSizingNow := FALSE;\r
3999   end;\r
4000 \r
4001   LogOK;\r
4002   finally\r
4003   Log( '<-TKOLCustomControl.AutoSizeNow' );\r
4004   end;\r
4005 end;\r
4006 \r
4007 function TKOLCustomControl.AutoWidth(Canvas: TCanvas): Integer;\r
4008 var Txt: String;\r
4009     Sz: TSize;\r
4010 begin\r
4011   asm\r
4012     jmp @@e_signature\r
4013     DB '#$signature$#', 0\r
4014     DB 'TKOLCustomControl.AutoWidth', 0\r
4015   @@e_signature:\r
4016   end;\r
4017   Log( '->TKOLCustomControl.AutoWidth' );\r
4018   try\r
4019   Txt := Caption;\r
4020   if fsItalic in Font.FontStyle then\r
4021     Txt := Txt + ' ';\r
4022   //Result := Canvas.TextWidth( Txt );\r
4023   Windows.GetTextExtentPoint32( Canvas.Handle, PChar( Txt ), Length( Txt ),\r
4024                                 Sz );\r
4025   Result := Sz.cx;\r
4026   LogOK;\r
4027   finally\r
4028   Log( '<-TKOLCustomControl.AutoWidth' );\r
4029   end;\r
4030 end;\r
4031 \r
4032 procedure TKOLCustomControl.Change;\r
4033 begin\r
4034   asm\r
4035     jmp @@e_signature\r
4036     DB '#$signature$#', 0\r
4037     DB 'TKOLCustomControl.Change', 0\r
4038   @@e_signature:\r
4039   end;\r
4040   //Log( '->TKOLCustomControl.Change' );\r
4041   try\r
4042   if not fChangingNow then\r
4043   begin\r
4044     fChangingNow := TRUE;\r
4045     try\r
4046       if not (csLoading in ComponentState) then\r
4047       if ParentKOLForm <> nil then\r
4048         ParentKOLForm.Change( Self );\r
4049     finally\r
4050       fChangingNow := FALSE;\r
4051     end;\r
4052   end;\r
4053   //LogOK;\r
4054   finally\r
4055   //Log( '<-TKOLCustomControl.Change' );\r
4056   end;\r
4057 end;\r
4058 \r
4059 procedure TKOLCustomControl.Click;\r
4060 begin\r
4061   asm\r
4062     jmp @@e_signature\r
4063     DB '#$signature$#', 0\r
4064     DB 'TKOLCustomControl.Click', 0\r
4065   @@e_signature:\r
4066   end;\r
4067   //\r
4068 end;\r
4069 \r
4070 function TKOLCustomControl.ClientMargins: TRect;\r
4071 begin\r
4072   asm\r
4073     jmp @@e_signature\r
4074     DB '#$signature$#', 0\r
4075     DB 'TKOLCustomControl.ClientMargins', 0\r
4076   @@e_signature:\r
4077   end;\r
4078   Result :=  Rect( 0, 0, 0, 0 );\r
4079 end;\r
4080 \r
4081 procedure TKOLCustomControl.CollectChildrenWithParentColor;\r
4082 var I: Integer;\r
4083     C: TComponent;\r
4084 begin\r
4085   asm\r
4086     jmp @@e_signature\r
4087     DB '#$signature$#', 0\r
4088     DB 'TKOLCustomControl.CollectChildrenWithParentFont', 0\r
4089   @@e_signature:\r
4090   end;\r
4091   Log( '->TKOLCustomControl.CollectChildrenWithParentColor' );\r
4092   try\r
4093   FParentLikeColorControls.Clear;\r
4094   for I := 0 to ParentForm.ComponentCount - 1 do\r
4095   begin\r
4096     C := ParentForm.Components[ I ];\r
4097     if (C is TKOLCustomControl) and ((C as TKOLCustomControl).Parent = Self) then\r
4098     if (C as TKOLCustomControl).parentColor then\r
4099       FParentLikeColorControls.Add( C );\r
4100   end;\r
4101   LogOK;\r
4102   finally\r
4103   Log( '<-TKOLCustomControl.CollectChildrenWithParentColor' );\r
4104   end;\r
4105 end;\r
4106 \r
4107 procedure TKOLCustomControl.CollectChildrenWithParentFont;\r
4108 var I: Integer;\r
4109     C: TComponent;\r
4110 begin\r
4111   asm\r
4112     jmp @@e_signature\r
4113     DB '#$signature$#', 0\r
4114     DB 'TKOLCustomControl.CollectChildrenWithParentFont', 0\r
4115   @@e_signature:\r
4116   end;\r
4117   Log( '->TKOLCustomControl.CollectChildrenWithParentFont' );\r
4118   try\r
4119   FParentLikeFontControls.Clear;\r
4120   for I := 0 to ParentForm.ComponentCount - 1 do\r
4121   begin\r
4122     C := ParentForm.Components[ I ];\r
4123     if (C is TKOLCustomControl) and ((C as TKOLCustomControl).Parent = Self) then\r
4124     if (C as TKOLCustomControl).ParentFont then\r
4125       FParentLikeFontControls.Add( C );\r
4126   end;\r
4127   LogOK;\r
4128   finally\r
4129   Log( '<-TKOLCustomControl.CollectChildrenWithParentFont' );\r
4130   end;\r
4131 end;\r
4132 \r
4133 function TKOLCustomControl.ControlIndex: Integer;\r
4134 var I: Integer;\r
4135 begin\r
4136   asm\r
4137     jmp @@e_signature\r
4138     DB '#$signature$#', 0\r
4139     DB 'TKOLCustomControl.ControlIndex', 0\r
4140   @@e_signature:\r
4141   end;\r
4142   Log( '->TKOLCustomControl.ControlIndex' );\r
4143   try\r
4144   Result := -1;\r
4145   for I := 0 to Parent.ControlCount-1 do\r
4146     if Parent.Controls[ I ] = Self then\r
4147     begin\r
4148       Result := I;\r
4149       break;\r
4150     end;\r
4151   LogOK;\r
4152   finally\r
4153   Log( '<-TKOLCustomControl.ControlIndex' );\r
4154   end;\r
4155 end;\r
4156 \r
4157 constructor TKOLCustomControl.Create(AOwner: TComponent);\r
4158 var F: TKOLForm;\r
4159     K: TComponent;\r
4160     ColorOfParent: TColor;\r
4161 begin\r
4162   asm\r
4163     jmp @@e_signature\r
4164     DB '#$signature$#', 0\r
4165     DB 'TKOLCustomControl.Create', 0\r
4166   @@e_signature:\r
4167   end;\r
4168   Log( '->TKOLCustomControl.Create' );\r
4169   try\r
4170 \r
4171   FTabOrder := -2;\r
4172   fNotifyList := TList.Create;\r
4173   {$IFDEF NOT_USE_KOLCTRLWRAPPER}\r
4174   FAllowSelfPaint := TRUE;\r
4175   {$ENDIF NOT_USE_KOLCTRLWRAPPER}\r
4176   inherited;\r
4177 \r
4178   {if not(csLoading in ComponentState) then\r
4179   if OwnerKOLForm( AOwner ) = nil then\r
4180   begin\r
4181     raise Exception.Create( 'You forget to place TKOLForm or descendant component onto the form!'#13#10 +\r
4182           'Check also if TKOLProject already dropped onto the main form.' +\r
4183           #13#10'classname = ' + ClassName );\r
4184   end;}\r
4185 \r
4186   FIsGenerateSize := TRUE;\r
4187   FIsGeneratePosition := TRUE;\r
4188   fAutoSzX := 4;\r
4189   fAutoSzY := 4;\r
4190   FParentFont := TRUE;\r
4191   FParentColor := TRUE;\r
4192   FParentLikeFontControls := TList.Create;\r
4193   FParentLikeColorControls := TList.Create;\r
4194   FFont := TKOLFont.Create( Self );\r
4195   FBrush := TKOLBrush.Create( Self );\r
4196   Width := 64;  DefaultWidth := Width;\r
4197   Height := 64; DefaultHeight := Height;\r
4198 \r
4199   fMargin := 2;\r
4200   K := ParentKOLControl;\r
4201 \r
4202   if K <> nil then\r
4203   if not( K is TKOLCustomControl ) then\r
4204     K := nil;\r
4205 \r
4206   F := ParentKOLForm;\r
4207 \r
4208   ColorOfParent := clBtnFace;\r
4209   if K <> nil then\r
4210   begin\r
4211     fCtl3D := (K as TKOLCustomControl).Ctl3D;\r
4212     ColorOfParent := (K as TKOLCustomControl).Color;\r
4213   end\r
4214     else\r
4215   if F <> nil then\r
4216   begin\r
4217     fCtl3D := F.Ctl3D;\r
4218     ColorOfParent := F.Color;\r
4219   end\r
4220   else\r
4221     fCtl3D := True;\r
4222 \r
4223   if DefaultParentColor then\r
4224   begin\r
4225     //Color := DefaultColor;\r
4226     //Color := ColorOfParent;\r
4227     FParentColor := FALSE;\r
4228     ParentColor := TRUE;\r
4229   end\r
4230     else\r
4231   begin\r
4232     Color := ColorOfParent;\r
4233     parentColor := FALSE;\r
4234     Color := DefaultInitialColor;\r
4235   end;\r
4236 \r
4237   //FparentColor := Color = ColorOfParent;\r
4238 \r
4239   //inherited Color := Color;\r
4240 \r
4241   FHasBorder := TRUE;\r
4242   FDefHasBorder := TRUE;\r
4243   //Change;\r
4244 \r
4245   LogOK;\r
4246   finally\r
4247   Log( '<-TKOLCustomControl.Create' );\r
4248   end;\r
4249 end;\r
4250 \r
4251 destructor TKOLCustomControl.Destroy;\r
4252 var F: TKOLForm;\r
4253     SaveAlign: TKOLAlign;\r
4254     I: Integer;\r
4255     C: TComponent;\r
4256 begin\r
4257   asm\r
4258     jmp @@e_signature\r
4259     DB '#$signature$#', 0\r
4260     DB 'TKOLCustomControl.Destroy', 0\r
4261   @@e_signature:\r
4262   end;\r
4263   Log( '->TKOLCustomControl.Destroy' );\r
4264   try\r
4265 \r
4266   if Assigned( Owner ) and not (csDestroying in Owner.ComponentState) then\r
4267   if Assigned( fNotifyList ) then\r
4268     for I := fNotifyList.Count-1 downto 0 do\r
4269     begin\r
4270       C := fNotifyList[ I ];\r
4271       if C is TKOLObj then\r
4272         (C as TKOLObj).NotifyLinkedComponent( Self, noRemoved )\r
4273       else\r
4274       if C is TKOLCustomControl then\r
4275         (C as TKOLCustomControl).NotifyLinkedComponent( Self, noRemoved );\r
4276     end;\r
4277   F := nil;\r
4278   if Owner <> nil then\r
4279   begin\r
4280     F := ParentKOLForm;\r
4281     if F <> nil then\r
4282     begin\r
4283       if F.fDefaultBtnCtl = Self then\r
4284         F.fDefaultBtnCtl := nil;\r
4285       if F.fCancelBtnCtl = Self then\r
4286         F.fCancelBtnCtl := nil;\r
4287       SaveAlign := FAlign;\r
4288       FAlign := caNone;\r
4289       ReAlign( TRUE ); //-- realign only parent\r
4290       FAlign := SaveAlign;\r
4291     end;\r
4292   end;\r
4293   FFont.Free;\r
4294   FParentLikeFontControls.Free;\r
4295   FParentLikeColorControls.Free;\r
4296   fNotifyList.Free;\r
4297   fNotifyList := nil;\r
4298   FBrush.Free;  {YS}//! Memory leak fix\r
4299   inherited;\r
4300   if F <> nil then\r
4301     F.Change( F );\r
4302 \r
4303   LogOK;\r
4304   finally\r
4305   Log( '<-TKOLCustomControl.Destroy' );\r
4306   end;\r
4307 end;\r
4308 \r
4309 procedure TKOLCustomControl.DoAssignEvents(SL: TStringList; const AName: String;\r
4310   EventNames: array of PChar; EventHandlers: array of Pointer);\r
4311 var I: Integer;\r
4312 begin\r
4313   asm\r
4314     jmp @@e_signature\r
4315     DB '#$signature$#', 0\r
4316     DB 'TKOLCustomControl.DoAssignEvents', 0\r
4317   @@e_signature:\r
4318   end;\r
4319   //Log( '->TKOLCustomControl.DoAssignEvents' );\r
4320   try\r
4321 \r
4322   for I := 0 to High( EventHandlers ) do\r
4323   begin\r
4324     if EventHandlers[ I ] <> nil then\r
4325     SL.Add( '      ' + AName + '.' + EventNames[ I ] + ' := Result.' +\r
4326             ParentForm.MethodName( EventHandlers[ I ] ) + ';' );\r
4327   end;\r
4328 \r
4329   //LogOK;\r
4330   finally\r
4331   //Log( '<-TKOLCustomControl.DoAssignEvents' );\r
4332   end;\r
4333 end;\r
4334 \r
4335 function TKOLCustomControl.DrawMargins: TRect;\r
4336 begin\r
4337   asm\r
4338     jmp @@e_signature\r
4339     DB '#$signature$#', 0\r
4340     DB 'TKOLCustomControl.DrawMargins', 0\r
4341   @@e_signature:\r
4342   end;\r
4343   Result := ClientMargins;\r
4344 end;\r
4345 \r
4346 procedure TKOLCustomControl.FirstCreate;\r
4347 begin\r
4348   asm\r
4349     jmp @@e_signature\r
4350     DB '#$signature$#', 0\r
4351     DB 'TKOLCustomControl.FirstCreate', 0\r
4352   @@e_signature:\r
4353   end;\r
4354   Log( '->TKOLCustomControl.FirstCreate' );\r
4355   try\r
4356   if Owner <> nil then\r
4357   if Owner is TKOLCustomControl then\r
4358   begin\r
4359     Transparent := (Owner as TKOLCustomControl).Transparent;\r
4360     {ShowMessage( 'First create of ' + Name + ' and owner Transparent = ' +\r
4361                  IntToStr( Integer( (Owner as TKOLCustomControl).Transparent ) ) );}\r
4362     if (Owner as TKOLCustomControl).Transparent then\r
4363     begin\r
4364     end;\r
4365   end;\r
4366   LogOK;\r
4367   finally\r
4368   Log( '<-TKOLCustomControl.FirstCreate' );\r
4369   end;\r
4370 end;\r
4371 \r
4372 const\r
4373   AlignValues: array[ TKOLAlign ] of String = ( 'caNone', 'caLeft', 'caTop',\r
4374                'caRight', 'caBottom', 'caClient' );\r
4375 \r
4376 function TKOLCustomControl.GenerateTransparentInits: String;\r
4377 var KF: TKOLForm;\r
4378     S, S1, S2: String;\r
4379 begin\r
4380   asm\r
4381     jmp @@e_signature\r
4382     DB '#$signature$#', 0\r
4383     DB 'TKOLCustomControl.GenerateTransparentInits', 0\r
4384   @@e_signature:\r
4385   end;\r
4386   Log( '->TKOLCustomControl.GenerateTransparentInits' );\r
4387   try\r
4388 \r
4389   S := ''; // ïîêà íè÷åãî íå íàäî\r
4390   if Align = caNone then\r
4391   begin\r
4392     if IsGenerateSize then\r
4393     begin\r
4394       if PlaceRight then\r
4395         S := '.PlaceRight'\r
4396       else\r
4397       if PlaceDown then\r
4398         S := '.PlaceDown'\r
4399       else\r
4400       if PlaceUnder then\r
4401         S := '.PlaceUnder'\r
4402       else\r
4403       if not CenterOnParent then\r
4404       if (actualLeft <> ParentMargin) or (actualTop <> ParentMargin) then\r
4405       begin\r
4406         S1 := IntToStr( actualLeft );\r
4407         S2 := IntToStr( actualTop );\r
4408         S := '.SetPosition( ' + S1 + ', ' + S2 + ' )';\r
4409       end;\r
4410     end;\r
4411   end;\r
4412   if Align <> caNone then\r
4413     S := S + '.SetAlign ( ' + AlignValues[ Align ] + ' )';\r
4414   S := S + Generate_SetSize;\r
4415   if CenterOnParent and (Align = caNone) then\r
4416     S := S + '.CenterOnParent';\r
4417   KF := ParentKOLForm;\r
4418   if KF <> nil then\r
4419   if KF.zOrderChildren then\r
4420     S := S + '.BringToFront';\r
4421   if EditTabChar then\r
4422     S := S + '.EditTabChar';\r
4423   if (HelpContext <> 0) and (Faction = nil) then\r
4424     S := S + '.AssignHelpContext( ' + IntToStr( HelpContext ) + ' )' ;\r
4425   if Unicode then\r
4426     S := S + '.SetUnicode( TRUE )';\r
4427   Result := Trim( S );\r
4428 \r
4429   LogOK;\r
4430   finally\r
4431   Log( '<-TKOLCustomControl.GenerateTransparentInits' );\r
4432   end;\r
4433 end;\r
4434 \r
4435 function TKOLCustomControl.GetActualLeft: Integer;\r
4436 var P: TControl;\r
4437     R: TRect;\r
4438 begin\r
4439   asm\r
4440     jmp @@e_signature\r
4441     DB '#$signature$#', 0\r
4442     DB 'TKOLCustomControl.GetActualLeft', 0\r
4443   @@e_signature:\r
4444   end;\r
4445   Log( '->TKOLCustomControl.GetActualLeft' );\r
4446   try\r
4447   Result := Left;\r
4448   P := Parent;\r
4449   if P is TKOLCustomControl then\r
4450   begin\r
4451     R := (P as TKOLCustomControl).ClientMargins;\r
4452     Dec( Result, R.Left );\r
4453   end;\r
4454   LogOK;\r
4455   finally\r
4456   Log( '<-TKOLCustomControl.GetActualLeft' );\r
4457   end;\r
4458 end;\r
4459 \r
4460 function TKOLCustomControl.GetActualTop: Integer;\r
4461 var P: TControl;\r
4462     R: TRect;\r
4463 begin\r
4464   asm\r
4465     jmp @@e_signature\r
4466     DB '#$signature$#', 0\r
4467     DB 'GetActualTop', 0\r
4468   @@e_signature:\r
4469   end;\r
4470   Log( '->TKOLCustomControl.GetActualTop' );\r
4471   try\r
4472   Result := Top;\r
4473   P := Parent;\r
4474   if P is TKOLCustomControl then\r
4475   begin\r
4476     R := (P as TKOLCustomControl).ClientMargins;\r
4477     Dec( Result, R.Top );\r
4478   end;\r
4479   LogOK;\r
4480   finally\r
4481   Log( '<-TKOLCustomControl.GetActualTop' );\r
4482   end;\r
4483 end;\r
4484 \r
4485 function TKOLCustomControl.GetParentColor: Boolean;\r
4486 var KF: TKOLForm;\r
4487     KC: TKOLCustomControl;\r
4488     C: TComponent;\r
4489 begin\r
4490   asm\r
4491     jmp @@e_signature\r
4492     DB '#$signature$#', 0\r
4493     DB 'TKOLCustomControl.GetParentColor', 0\r
4494   @@e_signature:\r
4495   end;\r
4496   Log( '->TKOLCustomControl.GetParentColor' );\r
4497   try\r
4498 \r
4499   Result := FParentColor;\r
4500   if Result then\r
4501   begin\r
4502     C := ParentKOLControl;\r
4503     if C = nil then\r
4504     begin\r
4505       LogOK;\r
4506       Exit;\r
4507     end;\r
4508     if C is TKOLForm then\r
4509     begin\r
4510       KF := C as TKOLForm;\r
4511       if Color <> KF.Color then\r
4512         Color := KF.Color;\r
4513     end\r
4514       else\r
4515     begin\r
4516       KC := C as TKOLCustomControl;\r
4517       if Color <> KC.Color then\r
4518         Color := KC.Color;\r
4519     end;\r
4520   end;\r
4521 \r
4522   LogOK;\r
4523   finally\r
4524   Log( '<-TKOLCustomControl.GetParentColor' );\r
4525   end;\r
4526 end;\r
4527 \r
4528 function TKOLCustomControl.GetParentFont: Boolean;\r
4529 var KF: TKOLForm;\r
4530     KC: TKOLCustomControl;\r
4531     C: TComponent;\r
4532 begin\r
4533   asm\r
4534     jmp @@e_signature\r
4535     DB '#$signature$#', 0\r
4536     DB 'TKOLCustomControl.GetParentFont', 0\r
4537   @@e_signature:\r
4538   end;\r
4539   Log( '->TKOLCustomControl.GetParentFont' );\r
4540   try\r
4541 \r
4542   Result := FParentFont;\r
4543   if Result then\r
4544   begin\r
4545     C := ParentKOLControl;\r
4546     if C = nil then\r
4547     begin\r
4548       LogOK;\r
4549       Exit;\r
4550     end;\r
4551     if C is TKOLForm then\r
4552     begin\r
4553       KF := C as TKOLForm;\r
4554       if not Font.Equal2( KF.Font ) then\r
4555         Font.Assign( KF.Font );\r
4556     end\r
4557       else\r
4558     begin\r
4559       KC := C as TKOLCustomControl;\r
4560       if not Font.Equal2( KC.Font ) then\r
4561         Font.Assign( KC.Font );\r
4562     end;\r
4563   end;\r
4564 \r
4565   LogOK;\r
4566   finally\r
4567   Log( '<-TKOLCustomControl.GetParentFont' );\r
4568   end;\r
4569 end;\r
4570 \r
4571 function TKOLCustomControl.GetTabOrder: Integer;\r
4572 var I, J, N: Integer;\r
4573     K, C: TComponent;\r
4574     kC: TKOLCustomControl;\r
4575     Found: Boolean;\r
4576     L: TList;\r
4577 begin\r
4578   asm\r
4579     jmp @@e_signature\r
4580     DB '#$signature$#', 0\r
4581     DB 'TKOLCustomControl.GetTabOrder', 0\r
4582   @@e_signature:\r
4583   end;\r
4584   //Log( '->TKOLCustomControl.GetTabOrder' );\r
4585   try\r
4586 \r
4587   //Old := FTabOrder;\r
4588   Result := FTabOrder;\r
4589   {if Old <> Result then\r
4590     ShowMessage( Name + '.TabOrder := ' + Int2Str( Result ) );}\r
4591   if Result = -2 then\r
4592   begin\r
4593     if (csLoading in ComponentState) or FAdjustingTabOrder then\r
4594     begin\r
4595       //LogOK;\r
4596       Exit;\r
4597     end;\r
4598     FAdjustingTabOrder := TRUE;\r
4599     L := TList.Create;\r
4600     try\r
4601       K := ParentForm;\r
4602       if K <> nil then\r
4603       begin\r
4604         for I := 0 to K.ComponentCount - 1 do\r
4605         begin\r
4606           C := K.Components[ I ];\r
4607           //if C = Self then continue;\r
4608           if not( C is TKOLCustomControl ) then continue;\r
4609           kC := C as TKOLCustomControl;\r
4610           if kC.Parent <> Parent then continue;\r
4611           L.Add( kC );\r
4612         end;\r
4613         for I := 0 to L.Count - 1 do\r
4614         begin\r
4615           kC := L[ I ];\r
4616           //ShowMessage( 'Check ' + kC.Name + ' with TabOrder = ' + IntToStr( kC.FTabOrder ) );\r
4617           if (kC.FTabOrder = Result) or (Result <= -2) then\r
4618           begin\r
4619             //ShowMessage( '! ' + kC.Name + '.TabOrder also = ' + IntToStr( Result ) );\r
4620             for N := 0 to MaxInt do\r
4621             begin\r
4622               Found := FALSE;\r
4623               for J := 0 to L.Count - 1 do\r
4624               begin\r
4625                 kC := L[ J ];\r
4626                 if kC.FTabOrder = N then\r
4627                 begin\r
4628                   Found := TRUE;\r
4629                   break;\r
4630                 end;\r
4631               end;\r
4632               if not Found then\r
4633               begin\r
4634                 //ShowMessage( 'TabOrder ' + IntToStr( N ) + ' is not yet used. ( ). Assign to ' + Name );\r
4635                 FTabOrder := N;\r
4636                 break;\r
4637               end;\r
4638             end;\r
4639             break;\r
4640           end;\r
4641         end;\r
4642       end;\r
4643     finally\r
4644       FAdjustingTabOrder := FALSE;\r
4645       L.Free;\r
4646     end;\r
4647   end;\r
4648   if FTabOrder < 0 then\r
4649     FTabOrder := -1;\r
4650   if FTabOrder > 100000 then\r
4651     FTabOrder := 100000;\r
4652   Result := FTabOrder;\r
4653 \r
4654   //LogOK;\r
4655   finally\r
4656   //Log( '<-TKOLCustomControl.GetTabOrder' );\r
4657   end;\r
4658 end;\r
4659 \r
4660 function TKOLCustomControl.Get_Color: TColor;\r
4661 begin\r
4662   asm\r
4663     jmp @@e_signature\r
4664     DB '#$signature$#', 0\r
4665     DB 'TKOLCustomControl.Get_Color', 0\r
4666   @@e_signature:\r
4667   end;\r
4668   Log( '->TKOLCustomControl.Get_Color' );\r
4669   try\r
4670   Result := inherited Color;\r
4671   LogOK;\r
4672   finally\r
4673   Log( '<-TKOLCustomControl.Get_Color' );\r
4674   end;\r
4675 end;\r
4676 \r
4677 function TKOLCustomControl.Get_Enabled: Boolean;\r
4678 begin\r
4679   asm\r
4680     jmp @@e_signature\r
4681     DB '#$signature$#', 0\r
4682     DB 'TKOLCustomControl.Get_Enabled', 0\r
4683   @@e_signature:\r
4684   end;\r
4685   Log( '->TKOLCustomControl.Get_Enabled' );\r
4686   try\r
4687   Result := inherited Enabled;\r
4688   LogOK;\r
4689   finally\r
4690   Log( '<-TKOLCustomControl.Get_Enabled' );\r
4691   end;\r
4692 end;\r
4693 \r
4694 function TKOLCustomControl.Get_Visible: Boolean;\r
4695 begin\r
4696   asm\r
4697     jmp @@e_signature\r
4698     DB '#$signature$#', 0\r
4699     DB 'TKOLCustomControl.Get_Visible', 0\r
4700   @@e_signature:\r
4701   end;\r
4702   Log( '->TKOLCustomControl.Get_Visible' );\r
4703   //Rpt( 'where from Get_Visible called?' );\r
4704   //Rpt_Stack;\r
4705   try\r
4706   Result := inherited Visible;\r
4707   LogOK;\r
4708   finally\r
4709   Log( '<-TKOLCustomControl.Get_Visible' );\r
4710   end;\r
4711 end;\r
4712 \r
4713 function TKOLCustomControl.IsCursorDefault: Boolean;\r
4714 begin\r
4715   asm\r
4716     jmp @@e_signature\r
4717     DB '#$signature$#', 0\r
4718     DB 'TKOLCustomControl.IsCursorDefault', 0\r
4719   @@e_signature:\r
4720   end;\r
4721   Log( '->TKOLCustomControl.IsCursorDefault' );\r
4722   try\r
4723   Result := TRUE;\r
4724   if Trim( Cursor_ ) <> '' then\r
4725   if (ParentKOLControl = ParentKOLForm) and (ParentKOLForm.Cursor <> Cursor_)\r
4726   or (ParentKOLControl <> ParentKOLForm) and ((ParentKOLControl as TKOLCustomControl).Cursor_ <> Cursor_) then\r
4727     Result := FALSE;\r
4728   LogOK;\r
4729   finally\r
4730   Log( '<-TKOLCustomControl.IsCursorDefault' );\r
4731   end;\r
4732 end;\r
4733 \r
4734 procedure TKOLCustomControl.Paint;\r
4735 var R, MR: TRect;\r
4736     P: TPoint;\r
4737 \r
4738     procedure PaintAdditional;\r
4739     begin\r
4740 \r
4741     end;\r
4742 \r
4743 begin\r
4744   asm\r
4745     jmp @@e_signature\r
4746     DB '#$signature$#', 0\r
4747     DB 'TKOLCustomControl.Paint', 0\r
4748   @@e_signature:\r
4749   end;\r
4750   Log( '->TKOLCustomControl.Paint' );\r
4751   try\r
4752 \r
4753   R := ClientRect;\r
4754   case PaintType of\r
4755   {$IFDEF _KOLCtrlWrapper_}\r
4756   ptWYSIWIG:\r
4757       if WYSIWIGPaintImplemented or Assigned(FKOLCtrl) then {YS}\r
4758       begin\r
4759         PaintAdditional;\r
4760         LogOK;\r
4761         Exit;\r
4762       end;\r
4763 {YS}\r
4764   {$ELSE}\r
4765   ptWYSIWIG,\r
4766   {$ENDIF}\r
4767   ptWYSIWIGCustom:\r
4768       if WYSIWIGPaintImplemented then\r
4769       begin\r
4770         PaintAdditional;\r
4771         LogOK;\r
4772         Exit;\r
4773       end;\r
4774 {YS}\r
4775   ptWYSIWIGFrames:\r
4776       if WYSIWIGPaintImplemented\r
4777          {$IFDEF _KOLCtrlWrapper_} or Assigned(FKOLCtrl) {YS} {$ENDIF}\r
4778          then \r
4779       begin\r
4780         PaintAdditional;\r
4781         if not NoDrawFrame then\r
4782         begin\r
4783           Canvas.Pen.Color := clBtnShadow;\r
4784           Canvas.Brush.Style := bsClear;\r
4785           Canvas.RoundRect( R.Left, R.Top, R.Right, R.Bottom, 3, 3 );\r
4786         end;\r
4787         LogOK;\r
4788         Exit;\r
4789       end;\r
4790   end;\r
4791   inherited;\r
4792   Canvas.Brush.Style := bsSolid;\r
4793   Canvas.Brush.Color := clBtnFace; // Color;\r
4794   Canvas.FillRect( R );\r
4795   Canvas.Pen.Color := clWindowText;\r
4796   Canvas.Brush.Color := clDkGray;\r
4797   Canvas.RoundRect( R.Left, R.Top, R.Right, R.Bottom, 3, 3 );\r
4798   InflateRect( R, -1, -1 );\r
4799   MR := DrawMargins;\r
4800   if MR.Left > 1 then\r
4801     Inc( R.Left, MR.Left-1 );\r
4802   if MR.Top > 1 then\r
4803     Inc( R.Top, MR.Top-1 );\r
4804   if MR.Right > 1 then\r
4805     Dec( R.Right, MR.Right-1 );\r
4806   if MR.Bottom > 1 then\r
4807     Dec( R.Bottom, MR.Bottom-1 );\r
4808   P := Point( 0, 0 );\r
4809   P.x := (Width - Canvas.TextWidth( Name )) div 2;\r
4810   if P.x < R.Left then P.x := R.Left;\r
4811   P.y := (Height - Canvas.TextHeight( Name )) div 2;\r
4812   if P.y < R.Top then P.y := R.Top;\r
4813   Canvas.Brush.Color := clBtnFace;\r
4814   //Canvas.Brush.Style := bsClear;\r
4815   Canvas.TextRect( R, P.x, P.y, Name );\r
4816 \r
4817   LogOK;\r
4818   finally\r
4819   Log( '<-TKOLCustomControl.Paint' );\r
4820   end;\r
4821 end;\r
4822 \r
4823 function TKOLCustomControl.ParentBounds: TRect;\r
4824 var C: TComponent;\r
4825 begin\r
4826   asm\r
4827     jmp @@e_signature\r
4828     DB '#$signature$#', 0\r
4829     DB 'TKOLCustomControl.ParentBounds', 0\r
4830   @@e_signature:\r
4831   end;\r
4832   Log( '->TKOLCustomControl.ParentBounds' );\r
4833   try\r
4834 \r
4835   Result := Rect( 0, 0, 0, 0 );\r
4836   C := ParentKOLControl;\r
4837   if C<> nil then\r
4838   if C is TKOLCustomControl then\r
4839     Result := (C as TKOLCustomControl).BoundsRect\r
4840   else\r
4841     Result := ParentForm.ClientRect;\r
4842 \r
4843   LogOK;\r
4844   finally\r
4845   Log( '<-TKOLCustomControl.ParentBounds' );\r
4846   end;\r
4847 end;\r
4848 \r
4849 function TKOLCustomControl.ParentControlUseAlign: Boolean;\r
4850 var C: TControl;\r
4851 begin\r
4852   asm\r
4853     jmp @@e_signature\r
4854     DB '#$signature$#', 0\r
4855     DB 'TKOLCustomControl.ParentControlUseAlign', 0\r
4856   @@e_signature:\r
4857   end;\r
4858   Log( '->TKOLCustomControl.ParentControlUseAlign' );\r
4859   try\r
4860 \r
4861   Result := False;\r
4862   C := Parent;\r
4863   if not(C is TForm) and (C is TKOLCustomControl) then\r
4864   begin\r
4865     Result := (C as TKOLCustomControl).Align <> caNone;\r
4866   end;\r
4867 \r
4868   LogOK;\r
4869   finally\r
4870   Log( '<-TKOLCustomControl.ParentControlUseAlign' );\r
4871   end;\r
4872 end;\r
4873 \r
4874 function TKOLCustomControl.ParentForm: TForm;\r
4875 var C: TComponent;\r
4876 begin\r
4877   asm\r
4878     jmp @@e_signature\r
4879     DB '#$signature$#', 0\r
4880     DB 'TKOLCustomControl.ParentForm', 0\r
4881   @@e_signature:\r
4882   end;\r
4883   //Log( '->TKOLCustomControl.ParentForm' );\r
4884   try\r
4885 \r
4886   C := Owner;\r
4887   while (C <> nil) and not(C is TForm) do\r
4888     C := C.Owner;\r
4889   Result := nil;\r
4890   if C <> nil then\r
4891   if C is TForm then\r
4892     Result := C as TForm;\r
4893 \r
4894   //LogOK;\r
4895   finally\r
4896   //Log( '<-TKOLCustomControl.ParentForm' );\r
4897   end;\r
4898 end;\r
4899 \r
4900 function TKOLCustomControl.ParentKOLControl: TComponent;\r
4901 begin\r
4902   asm\r
4903     jmp @@e_signature\r
4904     DB '#$signature$#', 0\r
4905     DB 'TKOLCustomControl.ParentKOLControl', 0\r
4906   @@e_signature:\r
4907   end;\r
4908   //Log( '->TKOLCustomControl.ParentKOLControl' );\r
4909   try\r
4910 \r
4911   Result := Parent;\r
4912   while (Result <> nil) and\r
4913         not (Result is TKOLCustomControl) and\r
4914         not (Result is TForm) do\r
4915     Result := (Result as TControl).Parent;\r
4916   if Result <> nil then\r
4917   if (Result is TForm) then\r
4918     Result := ParentKOLForm;\r
4919 \r
4920   //LogOK;\r
4921   finally\r
4922   //Log( '<-TKOLCustomControl.ParentKOLControl' );\r
4923   end;\r
4924 end;\r
4925 \r
4926 function TKOLCustomControl.ParentKOLForm: TKOLForm;\r
4927 var C, D: TComponent;\r
4928     I: Integer;\r
4929 begin\r
4930   asm\r
4931     jmp @@e_signature\r
4932     DB '#$signature$#', 0\r
4933     DB 'TKOLCustomControl.ParentKOLForm', 0\r
4934   @@e_signature:\r
4935   end;\r
4936   //Log( '->TKOLCustomControl.ParentKOLForm' );\r
4937   try\r
4938 \r
4939   C := Parent;\r
4940   {if C = nil then\r
4941     C := Owner;}\r
4942   while (C <> nil) and not(C is TForm) do\r
4943     if C is TControl then\r
4944       C := (C as TControl).Parent\r
4945     else\r
4946       C := nil;\r
4947   Result := nil;\r
4948   if C <> nil then\r
4949   if C is TForm then\r
4950   begin\r
4951     for I := 0 to (C as TForm).ComponentCount - 1 do\r
4952     begin\r
4953       D := (C as TForm).Components[ I ];\r
4954       if D is TKOLForm then\r
4955       begin\r
4956         Result := D as TKOLForm;\r
4957         break;\r
4958       end;\r
4959     end;\r
4960   end;\r
4961 \r
4962   //LogOK;\r
4963   finally\r
4964   //Log( '<-TKOLCustomControl.ParentKOLForm' );\r
4965   end;\r
4966 end;\r
4967 \r
4968 function TKOLCustomControl.ParentMargin: Integer;\r
4969 var C: TComponent;\r
4970 begin\r
4971   asm\r
4972     jmp @@e_signature\r
4973     DB '#$signature$#', 0\r
4974     DB 'TKOLCustomControl.ParentMargin', 0\r
4975   @@e_signature:\r
4976   end;\r
4977   Log( '->TKOLCustomControl.ParentMargin' );\r
4978   try\r
4979 \r
4980   C := ParentKOLControl;\r
4981   Result := 0;\r
4982   if C <> nil then\r
4983   if C is TKOLForm then\r
4984     Result := (C as TKOLForm).Margin\r
4985   else\r
4986     Result := (C as TKOLCustomControl).Margin;\r
4987 \r
4988   LogOK;\r
4989   finally\r
4990   Log( '<-TKOLCustomControl.ParentMargin' );\r
4991   end;\r
4992 end;\r
4993 \r
4994 function TKOLCustomControl.PrevBounds: TRect;\r
4995 var K: TKOLCustomControl;\r
4996 begin\r
4997   asm\r
4998     jmp @@e_signature\r
4999     DB '#$signature$#', 0\r
5000     DB 'TKOLCustomControl.PrevBounds', 0\r
5001   @@e_signature:\r
5002   end;\r
5003   Log( '->TKOLCustomControl.PrevBounds' );\r
5004   try\r
5005 \r
5006   Result := Rect( 0, 0, 0, 0 );\r
5007   K := PrevKOLControl;\r
5008   if K <> nil then\r
5009     Result := K.BoundsRect;\r
5010 \r
5011   LogOK;\r
5012   finally\r
5013   Log( '<-TKOLCustomControl.PrevBounds' );\r
5014   end;\r
5015 end;\r
5016 \r
5017 function TKOLCustomControl.PrevKOLControl: TKOLCustomControl;\r
5018 var F: TForm;\r
5019     I: Integer;\r
5020     C: TComponent;\r
5021 begin\r
5022   asm\r
5023     jmp @@e_signature\r
5024     DB '#$signature$#', 0\r
5025     DB 'TKOLCustomControl.PrevKOLControl', 0\r
5026   @@e_signature:\r
5027   end;\r
5028   Log( '->TKOLCustomControl.PrevKOLControl' );\r
5029   try\r
5030 \r
5031   Result := nil;\r
5032   if ParentKOLForm <> nil then\r
5033   begin\r
5034     F := (ParentKOLForm.Owner as TForm);\r
5035     for I := 0 to F.ComponentCount - 1 do\r
5036     begin\r
5037       C := F.Components[ I ];\r
5038       if C = Self then break;\r
5039       if C is TKOLCustomControl then\r
5040       if (C as TKOLCustomControl).Parent = Parent then\r
5041         Result := C as TKOLCustomControl;\r
5042     end;\r
5043   end;\r
5044 \r
5045   LogOK;\r
5046   finally\r
5047   Log( '<-TKOLCustomControl.PrevKOLControl' );\r
5048   end;\r
5049 end;\r
5050 \r
5051 function TKOLCustomControl.RefName: String;\r
5052 begin\r
5053   asm\r
5054     jmp @@e_signature\r
5055     DB '#$signature$#', 0\r
5056     DB 'TKOLCustomControl.RefName', 0\r
5057   @@e_signature:\r
5058   end;\r
5059   Result := 'Result.' + Name;\r
5060 end;\r
5061 \r
5062 procedure TKOLCustomControl.SetActualLeft(Value: Integer);\r
5063 var P: TControl;\r
5064     R: TRect;\r
5065 begin\r
5066   asm\r
5067     jmp @@e_signature\r
5068     DB '#$signature$#', 0\r
5069     DB 'TKOLCustomControl.SetActualLeft', 0\r
5070   @@e_signature:\r
5071   end;\r
5072   Log( '->TKOLCustomControl.SetActualLeft' );\r
5073   try\r
5074   P := Parent;\r
5075   if P is TKOLCustomControl then\r
5076   begin\r
5077     R := (P as TKOLCustomControl).ClientMargins;\r
5078     Inc( Value, R.Left );\r
5079   end;\r
5080   Left := Value;\r
5081   LogOK;\r
5082   finally\r
5083   Log( '<-TKOLCustomControl.SetActualLeft' );\r
5084   end;\r
5085 end;\r
5086 \r
5087 procedure TKOLCustomControl.SetActualTop(Value: Integer);\r
5088 var P: TControl;\r
5089     R: TRect;\r
5090 begin\r
5091   asm\r
5092     jmp @@e_signature\r
5093     DB '#$signature$#', 0\r
5094     DB 'TKOLCustomControl.SetActualTop', 0\r
5095   @@e_signature:\r
5096   end;\r
5097   Log( '->TKOLCustomControl.SetActualTop' );\r
5098   try\r
5099   P := Parent;\r
5100   if P is TKOLCustomControl then\r
5101   begin\r
5102     R := (P as TKOLCustomControl).ClientMargins;\r
5103     Inc( Value, R.Top );\r
5104   end;\r
5105   Top := Value;\r
5106   LogOK;\r
5107   finally\r
5108   Log( '<-TKOLCustomControl.SetActualTop' );\r
5109   end;\r
5110 end;\r
5111 \r
5112 procedure TKOLCustomControl.SetAlign(const Value: TKOLAlign);\r
5113 var\r
5114   DoSwap: boolean;\r
5115 begin\r
5116   asm\r
5117     jmp @@e_signature\r
5118     DB '#$signature$#', 0\r
5119     DB 'TKOLCustomControl.SetAlign', 0\r
5120   @@e_signature:\r
5121   end;\r
5122   Log( '->TKOLCustomControl.SetAlign' );\r
5123   try\r
5124   if fAlign <> Value then\r
5125   begin\r
5126     DoSwap:=not (csLoading in ComponentState) and (\r
5127             ((Value in [caLeft, caRight]) and (fAlign in [caTop, caBottom])) or\r
5128             ((fAlign in [caLeft, caRight]) and (Value in [caTop, caBottom])));\r
5129     fAlign := Value;\r
5130     if fAlign <> caNone then\r
5131     begin\r
5132       PlaceRight := False;\r
5133       PlaceDown := False;\r
5134       PlaceUnder := False;\r
5135       CenterOnParent := False;\r
5136     end;\r
5137     //inherited Align := alNone;\r
5138     {case Value of\r
5139     caNone:   inherited Align := alNone;\r
5140     caLeft:   inherited Align := alLeft;\r
5141     caTop:    inherited Align := alTop;\r
5142     caRight:  inherited Align := alRight;\r
5143     caBottom: inherited Align := alBottom;\r
5144     caClient: inherited Align := alClient;\r
5145     end;}\r
5146     if DoSwap then\r
5147       SetBounds(Left, Top, Height, Width)\r
5148     else\r
5149       ReAlign( FALSE );\r
5150     Change;\r
5151   end;\r
5152   LogOK;\r
5153   finally\r
5154   Log( '<-TKOLCustomControl.SetAlign' );\r
5155   end;\r
5156 end;\r
5157 \r
5158 procedure TKOLCustomControl.Set_autoSize(const Value: Boolean);\r
5159 begin\r
5160   asm\r
5161     jmp @@e_signature\r
5162     DB '#$signature$#', 0\r
5163     DB 'TKOLCustomControl.Set_autoSize', 0\r
5164   @@e_signature:\r
5165   end;\r
5166   Log( '->TKOLCustomControl.Set_autoSize' );\r
5167   try\r
5168   FautoSize := Value;\r
5169   if Value then\r
5170     AutoSizeNow;\r
5171   Change;\r
5172   LogOK;\r
5173   finally\r
5174   Log( '<-TKOLCustomControl.Set_autoSize' );\r
5175   end;\r
5176 end;\r
5177 \r
5178 procedure TKOLCustomControl.SetBounds(aLeft, aTop, aWidth, aHeight: Integer);\r
5179 var R: TRect;\r
5180 begin\r
5181   asm\r
5182     jmp @@e_signature\r
5183     DB '#$signature$#', 0\r
5184     DB 'TKOLCustomControl.SetBounds', 0\r
5185   @@e_signature:\r
5186   end;\r
5187   Log( '->TKOLCustomControl.SetBounds' );\r
5188   try\r
5189   TRY\r
5190     R := Rect( aLeft, aTop, aLeft + aWidth, aTop + aHeight );\r
5191     //Log( 'TKOLCustomControl.SetBounds1' );\r
5192     if Assigned( FOnSetBounds ) then\r
5193     begin\r
5194       //Log( 'TKOLCustomControl.SetBounds1A' );\r
5195       FOnSetBounds( Self, R );\r
5196       //Log( 'TKOLCustomControl.SetBounds1B' );\r
5197       aLeft := R.Left;\r
5198       aTop := R.Top;\r
5199       aWidth := R.Right - R.Left;\r
5200       aHeight := R.Bottom - R.Top;\r
5201     end;\r
5202     //Log( 'TKOLCustomControl.SetBounds2' );\r
5203     R := Rect( Left, Top, Left + Width, Top + Height );\r
5204     //Log( 'TKOLCustomControl.SetBounds3' );\r
5205     inherited SetBounds( aLeft, aTop, aWidth, aHeight );\r
5206     //Log( 'TKOLCustomControl.SetBounds4' );\r
5207     if AutoSize then AutoSizeNow;\r
5208     //Log( 'TKOLCustomControl.SetBounds5' );\r
5209     if (Left <> R.Left) or (Top <> R.Top) or\r
5210        (Width <> R.Right - R.Left) or (Height <> R.Bottom - R.Top) then\r
5211       ReAlign( FALSE );\r
5212     //Log( 'TKOLCustomControl.SetBounds6 (before Change)' );\r
5213     Change;\r
5214     //Log( 'TKOLCustomControl.SetBounds6 (after Change)' );\r
5215   EXCEPT\r
5216     on E: Exception do\r
5217     begin\r
5218       Rpt( 'Exception in TKOLCustomControl.SetBounds: ' + E.Message );\r
5219       Rpt_Stack;\r
5220     end;\r
5221   END;\r
5222   LogOK;\r
5223   finally\r
5224   Log( '<-TKOLCustomControl.SetBounds' );\r
5225   end;\r
5226 end;\r
5227 \r
5228 procedure TKOLCustomControl.SetCaption(const Value: String);\r
5229 begin\r
5230   asm\r
5231     jmp @@e_signature\r
5232     DB '#$signature$#', 0\r
5233     DB 'TKOLCustomControl.SetCaption', 0\r
5234   @@e_signature:\r
5235   end;\r
5236   Log( '->TKOLCustomControl.SetCaption' );\r
5237   try\r
5238 \r
5239   if fCaption = Value then\r
5240   begin\r
5241     LogOK;\r
5242     Exit;\r
5243   end;\r
5244   if Faction = nil then\r
5245     fCaption := Value\r
5246   else\r
5247     fCaption := Faction.Caption;\r
5248 {YS}\r
5249   {$IFDEF _KOLCtrlWrapper_}\r
5250   if Assigned(FKOLCtrl) then\r
5251     FKOLCtrl.Caption:=fCaption;\r
5252   {$ENDIF}\r
5253 {YS}\r
5254   if AutoSize then\r
5255     AutoSizeNow;\r
5256   Invalidate;\r
5257   Change;\r
5258 \r
5259   LogOK;\r
5260   finally\r
5261   Log( '<-TKOLCustomControl.SetCaption' );\r
5262   end;\r
5263 end;\r
5264 \r
5265 procedure TKOLCustomControl.SetCenterOnParent(const Value: Boolean);\r
5266 var R: TRect;\r
5267 begin\r
5268   asm\r
5269     jmp @@e_signature\r
5270     DB '#$signature$#', 0\r
5271     DB 'TKOLCustomControl.SetCenterOnParent', 0\r
5272   @@e_signature:\r
5273   end;\r
5274   Log( '->TKOLCustomControl.SetCenterOnParent' );\r
5275   try\r
5276 \r
5277   if (fAlign <> caNone) and Value then\r
5278   begin\r
5279     LogOK;\r
5280     Exit;\r
5281   end;\r
5282   fCenterOnParent := Value;\r
5283   if Value then\r
5284   begin\r
5285     PlaceRight := False;\r
5286     PlaceDown := False;\r
5287     PlaceUnder := False;\r
5288     if not (csLoading in ComponentState) then\r
5289     begin\r
5290       R := ParentBounds;\r
5291       Left := (R.Right - R.Left - Width) div 2;\r
5292       Top := (R.Bottom - R.Top - Height) div 2;\r
5293     end;\r
5294   end;\r
5295   Change;\r
5296 \r
5297   LogOK;\r
5298   finally\r
5299   Log( '<-TKOLCustomControl.SetCenterOnParent' );\r
5300   end;\r
5301 end;\r
5302 \r
5303 procedure TKOLCustomControl.SetClsStyle(const Value: DWORD);\r
5304 begin\r
5305   asm\r
5306     jmp @@e_signature\r
5307     DB '#$signature$#', 0\r
5308     DB 'TKOLCustomControl.SetClsStyle', 0\r
5309   @@e_signature:\r
5310   end;\r
5311   Log( '->TKOLCustomControl.SetClsStyle' );\r
5312   try\r
5313   fClsStyle := Value;\r
5314   Change;\r
5315   LogOK;\r
5316   finally\r
5317   Log( '<-TKOLCustomControl.SetClsStyle' );\r
5318   end;\r
5319 end;\r
5320 \r
5321 procedure TKOLCustomControl.SetCtl3D(const Value: Boolean);\r
5322 begin\r
5323   asm\r
5324     jmp @@e_signature\r
5325     DB '#$signature$#', 0\r
5326     DB 'TKOLCustomControl.SetCtl3D', 0\r
5327   @@e_signature:\r
5328   end;\r
5329   Log( '->TKOLCustomControl.SetCtl3D' );\r
5330   try\r
5331   FCtl3D := Value;\r
5332   if Assigned(FKOLCtrl) and not (csLoading in ComponentState) then\r
5333     FKOLCtrl.Ctl3D:=FCtl3D\r
5334   else\r
5335     Invalidate;\r
5336   Change;\r
5337   LogOK;\r
5338   finally\r
5339   Log( '<-TKOLCustomControl.SetCtl3D' );\r
5340   end;\r
5341 end;\r
5342 \r
5343 procedure TKOLCustomControl.SetCursor(const Value: String);\r
5344 begin\r
5345   asm\r
5346     jmp @@e_signature\r
5347     DB '#$signature$#', 0\r
5348     DB 'TKOLCustomControl.SetCursor', 0\r
5349   @@e_signature:\r
5350   end;\r
5351   Log( '->TKOLCustomControl.SetCursor' );\r
5352   try\r
5353   FCursor := Value;\r
5354   Change;\r
5355   LogOK;\r
5356   finally\r
5357   Log( '<-TKOLCustomControl.SetCursor' );\r
5358   end;\r
5359 end;\r
5360 \r
5361 procedure TKOLCustomControl.SetDoubleBuffered(const Value: Boolean);\r
5362 begin\r
5363   asm\r
5364     jmp @@e_signature\r
5365     DB '#$signature$#', 0\r
5366     DB 'TKOLCustomControl.SetDoubleBuffered', 0\r
5367   @@e_signature:\r
5368   end;\r
5369   Log( '->TKOLCustomControl.SetDoubleBuffered' );\r
5370   try\r
5371   FDoubleBuffered := Value;\r
5372   Change;\r
5373   LogOK;\r
5374   finally\r
5375   Log( '<-TKOLCustomControl.SetDoubleBuffered' );\r
5376   end;\r
5377 end;\r
5378 \r
5379 procedure TKOLCustomControl.SetEraseBackground(const Value: Boolean);\r
5380 begin\r
5381   asm\r
5382     jmp @@e_signature\r
5383     DB '#$signature$#', 0\r
5384     DB 'TKOLCustomControl.SetEraseBackground', 0\r
5385   @@e_signature:\r
5386   end;\r
5387   Log( '->TKOLCustomControl.SetEraseBackground' );\r
5388   try\r
5389   FEraseBackground := Value;\r
5390   Change;\r
5391   LogOK;\r
5392   finally\r
5393   Log( '<-TKOLCustomControl.SetEraseBackground' );\r
5394   end;\r
5395 end;\r
5396 \r
5397 procedure TKOLCustomControl.SetExStyle(const Value: DWORD);\r
5398 begin\r
5399   asm\r
5400     jmp @@e_signature\r
5401     DB '#$signature$#', 0\r
5402     DB 'TKOLCustomControl.SetExStyle', 0\r
5403   @@e_signature:\r
5404   end;\r
5405   Log( '->TKOLCustomControl.SetExStyle' );\r
5406   try\r
5407   fExStyle := Value;\r
5408   Change;\r
5409   LogOK;\r
5410   finally\r
5411   Log( '<-TKOLCustomControl.SetExStyle' );\r
5412   end;\r
5413 end;\r
5414 \r
5415 procedure TKOLCustomControl.SetFont(const Value: TKOLFont);\r
5416 var KF: TKOLForm;\r
5417     KC: TKOLCustomControl;\r
5418     C: TComponent;\r
5419 begin\r
5420   asm\r
5421     jmp @@e_signature\r
5422     DB '#$signature$#', 0\r
5423     DB 'TKOLCustomControl.SetFont', 0\r
5424   @@e_signature:\r
5425   end;\r
5426   Log( '->TKOLCustomControl.SetFont' );\r
5427   try\r
5428   if not (csLoading in ComponentState) then\r
5429   begin\r
5430     C := ParentKOLControl;\r
5431     if C <> nil then\r
5432     if C is TKOLForm then\r
5433     begin\r
5434       KF := C as TKOLForm;\r
5435       if not Value.Equal2( KF.Font ) then\r
5436         parentFont := FALSE;\r
5437     end\r
5438       else\r
5439     if C is TKOLCustomControl then\r
5440     begin\r
5441       KC := C as TKOLCustomControl;\r
5442       if not Value.Equal2( KC.Font ) then\r
5443         parentFont := FALSE;\r
5444     end;\r
5445   end;\r
5446   if not fFont.Equal2( Value ) then\r
5447   begin\r
5448     CollectChildrenWithParentFont;\r
5449     fFont.Assign( Value );\r
5450     ApplyFontToChildren;\r
5451     //if csLoading in ComponentState then\r
5452     //  FParentFont := DetectParentFont;\r
5453   end;\r
5454   LogOK;\r
5455   finally\r
5456   Log( '<-TKOLCustomControl.SetFont' );\r
5457   end;\r
5458 end;\r
5459 \r
5460 procedure TKOLCustomControl.SetMargin(const Value: Integer);\r
5461 begin\r
5462   asm\r
5463     jmp @@e_signature\r
5464     DB '#$signature$#', 0\r
5465     DB 'TKOLCustomControl.SetMargin', 0\r
5466   @@e_signature:\r
5467   end;\r
5468   Log( '->TKOLCustomControl.SetMargin' );\r
5469   try\r
5470   if fMargin <> Value then\r
5471   begin\r
5472     fMargin := Value;\r
5473     ReAlign( FALSE );\r
5474     Change;\r
5475     Invalidate;\r
5476   end;\r
5477   LogOK;\r
5478   finally\r
5479   Log( '<-TKOLCustomControl.SetMargin' );\r
5480   end;\r
5481 end;\r
5482 \r
5483 procedure TKOLCustomControl.SetMarginBottom(const Value: Integer);\r
5484 begin\r
5485   asm\r
5486     jmp @@e_signature\r
5487     DB '#$signature$#', 0\r
5488     DB 'TKOLCustomControl.SetMarginBottom', 0\r
5489   @@e_signature:\r
5490   end;\r
5491   Log( '->TKOLCustomControl.SetMarginBottom' );\r
5492   try\r
5493   if FMarginBottom <> Value then\r
5494   begin\r
5495     FMarginBottom := Value;\r
5496     ReAlign( FALSE );\r
5497     Change;\r
5498   end;\r
5499   LogOK;\r
5500   finally\r
5501   Log( '<-TKOLCustomControl.SetMarginBottom' );\r
5502   end;\r
5503 end;\r
5504 \r
5505 procedure TKOLCustomControl.SetMarginLeft(const Value: Integer);\r
5506 begin\r
5507   asm\r
5508     jmp @@e_signature\r
5509     DB '#$signature$#', 0\r
5510     DB 'TKOLCustomControl.SetMarginLeft', 0\r
5511   @@e_signature:\r
5512   end;\r
5513   Log( '->TKOLCustomControl.SetMarginLeft' );\r
5514   try\r
5515   if FMarginLeft <> Value then\r
5516   begin\r
5517     FMarginLeft := Value;\r
5518     ReAlign( FALSE );\r
5519     Change;\r
5520   end;\r
5521   LogOK;\r
5522   finally\r
5523   Log( '<-TKOLCustomControl.SetMarginLeft' );\r
5524   end;\r
5525 end;\r
5526 \r
5527 procedure TKOLCustomControl.SetMarginRight(const Value: Integer);\r
5528 begin\r
5529   asm\r
5530     jmp @@e_signature\r
5531     DB '#$signature$#', 0\r
5532     DB 'TKOLCustomControl.SetMarginRight', 0\r
5533   @@e_signature:\r
5534   end;\r
5535   Log( '->TKOLCustomControl.SetMarginRight' );\r
5536   try\r
5537   if FMarginRight <> Value then\r
5538   begin\r
5539     FMarginRight := Value;\r
5540     ReAlign( FALSE );\r
5541     Change;\r
5542   end;\r
5543   LogOK;\r
5544   finally\r
5545   Log( '<-TKOLCustomControl.SetMarginRight' );\r
5546   end;\r
5547 end;\r
5548 \r
5549 procedure TKOLCustomControl.SetMarginTop(const Value: Integer);\r
5550 begin\r
5551   asm\r
5552     jmp @@e_signature\r
5553     DB '#$signature$#', 0\r
5554     DB 'TKOLCustomControl.SetMarginTop', 0\r
5555   @@e_signature:\r
5556   end;\r
5557   Log( '->TKOLCustomControl.SetMarginTop' );\r
5558   try\r
5559   if FMarginTop <> Value then\r
5560   begin\r
5561     FMarginTop := Value;\r
5562     ReAlign( FALSE );\r
5563     Change;\r
5564   end;\r
5565   LogOK;\r
5566   finally\r
5567   Log( '<-TKOLCustomControl.SetMarginTop' );\r
5568   end;\r
5569 end;\r
5570 \r
5571 procedure TKOLCustomControl.SetName(const NewName: TComponentName);\r
5572 var OldName, NameNew: String;\r
5573     I, N: Integer;\r
5574     Success: Boolean;\r
5575 begin\r
5576   asm\r
5577     jmp @@e_signature\r
5578     DB '#$signature$#', 0\r
5579     DB 'TKOLCustomControl.SetName', 0\r
5580   @@e_signature:\r
5581   end;\r
5582   Log( '->TKOLCustomControl.SetName' );\r
5583   try\r
5584 \r
5585   OldName := Name;\r
5586   inherited SetName( NewName );\r
5587   if (Copy( NewName, 1, 3 ) = 'KOL') and (OldName = '') then\r
5588   begin\r
5589     NameNew := Copy( NewName, 4, Length( NewName ) - 3 );\r
5590     Success := True;\r
5591     if Owner <> nil then\r
5592     while Owner.FindComponent( NameNew ) <> nil do\r
5593     begin\r
5594       Success := False;\r
5595       for I := 1 to Length( NameNew ) do\r
5596       begin\r
5597         if NameNew[ I ] in [ '0'..'9' ] then\r
5598         begin\r
5599           Success := True;\r
5600           N := StrToInt( Copy( NameNew, I, Length( NameNew ) - I + 1 ) );\r
5601           Inc( N );\r
5602           NameNew := Copy( NameNew, 1, I - 1 ) + IntToStr( N );\r
5603           break;\r
5604         end;\r
5605       end;\r
5606       if not Success then break;\r
5607     end;\r
5608     if Success then\r
5609       Name := NameNew;\r
5610     if not (csLoading in ComponentState) then\r
5611       FirstCreate;\r
5612   end;\r
5613   Invalidate;\r
5614   Change;\r
5615 \r
5616   LogOK;\r
5617   finally\r
5618   Log( '<-TKOLCustomControl.SetName' );\r
5619   end;\r
5620 end;\r
5621 \r
5622 procedure TKOLCustomControl.SetOnBitBtnDraw(const Value: TOnBitBtnDraw);\r
5623 begin\r
5624   asm\r
5625     jmp @@e_signature\r
5626     DB '#$signature$#', 0\r
5627     DB 'TKOLCustomControl.SetOnBitBtnDraw', 0\r
5628   @@e_signature:\r
5629   end;\r
5630   Log( '->TKOLCustomControl.SetOnBitBtnDraw' );\r
5631   try\r
5632   FOnBitBtnDraw := Value;\r
5633   Change;\r
5634   LogOK;\r
5635   finally\r
5636   Log( '<-TKOLCustomControl.SetOnBitBtnDraw' );\r
5637   end;\r
5638 end;\r
5639 \r
5640 procedure TKOLCustomControl.SetOnChange(const Value: TOnEvent);\r
5641 begin\r
5642   asm\r
5643     jmp @@e_signature\r
5644     DB '#$signature$#', 0\r
5645     DB 'TKOLCustomControl.SetOnChange', 0\r
5646   @@e_signature:\r
5647   end;\r
5648   Log( '->TKOLCustomControl.SetOnChange' );\r
5649   try\r
5650   FOnChange := Value;\r
5651   Change;\r
5652   LogOK;\r
5653   finally\r
5654   Log( '<-TKOLCustomControl.SetOnChange' );\r
5655   end;\r
5656 end;\r
5657 \r
5658 procedure TKOLCustomControl.SetOnChar(const Value: TOnChar);\r
5659 begin\r
5660   asm\r
5661     jmp @@e_signature\r
5662     DB '#$signature$#', 0\r
5663     DB 'TKOLCustomControl.SetOnChar', 0\r
5664   @@e_signature:\r
5665   end;\r
5666   Log( 'TKOLCustomControl.SetOnChar' );\r
5667   try\r
5668   FOnChar := Value;\r
5669   Change;\r
5670   LogOK;\r
5671   finally\r
5672   Log( '<-OLCustomControl.SetOnChar' );\r
5673   end;\r
5674 end;\r
5675 \r
5676 procedure TKOLCustomControl.SetOnClick(const Value: TOnEvent);\r
5677 begin\r
5678   asm\r
5679     jmp @@e_signature\r
5680     DB '#$signature$#', 0\r
5681     DB 'TKOLCustomControl.SetOnClick', 0\r
5682   @@e_signature:\r
5683   end;\r
5684   Log( '->TKOLCustomControl.SetOnClick' );\r
5685   try\r
5686   fOnClick := Value;\r
5687   Change;\r
5688   LogOK;\r
5689   finally\r
5690   Log( '<-TKOLCustomControl.SetOnClick' );\r
5691   end;\r
5692 end;\r
5693 \r
5694 procedure TKOLCustomControl.SetOnCloseUp(const Value: TOnEvent);\r
5695 begin\r
5696   asm\r
5697     jmp @@e_signature\r
5698     DB '#$signature$#', 0\r
5699     DB 'TKOLCustomControl.SetOnCloseUp', 0\r
5700   @@e_signature:\r
5701   end;\r
5702   Log( '->TKOLCustomControl.SetOnCloseUp' );\r
5703   try\r
5704   FOnCloseUp := Value;\r
5705   Change;\r
5706   LogOK;\r
5707   finally\r
5708   Log( '<-TKOLCustomControl.SetOnCloseUp' );\r
5709   end;\r
5710 end;\r
5711 \r
5712 procedure TKOLCustomControl.SetOnColumnClick(const Value: TOnLVColumnClick);\r
5713 begin\r
5714   asm\r
5715     jmp @@e_signature\r
5716     DB '#$signature$#', 0\r
5717     DB 'TKOLCustomControl.SetOnColumnClick', 0\r
5718   @@e_signature:\r
5719   end;\r
5720   Log( '->TKOLCustomControl.SetOnColumnClick' );\r
5721   try\r
5722   FOnColumnClick := Value;\r
5723   Change;\r
5724   LogOK;\r
5725   finally\r
5726   Log( '<-TKOLCustomControl.SetOnColumnClick' );\r
5727   end;\r
5728 end;\r
5729 \r
5730 procedure TKOLCustomControl.SetOnCompareLVItems(const Value: TOnCompareLVItems);\r
5731 begin\r
5732   asm\r
5733     jmp @@e_signature\r
5734     DB '#$signature$#', 0\r
5735     DB 'TKOLCustomControl.SetOnCompareLVItems', 0\r
5736   @@e_signature:\r
5737   end;\r
5738   Log( '->TKOLCustomControl.SetOnCompareLVItems' );\r
5739   try\r
5740   FOnCompareLVItems := Value;\r
5741   Change;\r
5742   LogOK;\r
5743   finally\r
5744   Log( '<-TKOLCustomControl.SetOnCompareLVItems' );\r
5745   end;\r
5746 end;\r
5747 \r
5748 procedure TKOLCustomControl.SetOnDeleteAllLVItems(const Value: TOnEvent);\r
5749 begin\r
5750   asm\r
5751     jmp @@e_signature\r
5752     DB '#$signature$#', 0\r
5753     DB 'TKOLCustomControl.SetOnDeleteAllLVItems', 0\r
5754   @@e_signature:\r
5755   end;\r
5756   FOnDeleteAllLVItems := Value;\r
5757   Change;\r
5758 end;\r
5759 \r
5760 procedure TKOLCustomControl.SetOnDeleteLVItem(const Value: TOnDeleteLVItem);\r
5761 begin\r
5762   asm\r
5763     jmp @@e_signature\r
5764     DB '#$signature$#', 0\r
5765     DB 'TKOLCustomControl.SetOnDeleteLVItem', 0\r
5766   @@e_signature:\r
5767   end;\r
5768   FOnDeleteLVItem := Value;\r
5769   Change;\r
5770 end;\r
5771 \r
5772 procedure TKOLCustomControl.SetOnDestroy(const Value: TOnEvent);\r
5773 begin\r
5774   asm\r
5775     jmp @@e_signature\r
5776     DB '#$signature$#', 0\r
5777     DB 'TKOLCustomControl.SetOnDestroy', 0\r
5778   @@e_signature:\r
5779   end;\r
5780   FOnDestroy := Value;\r
5781   Change;\r
5782 end;\r
5783 \r
5784 procedure TKOLCustomControl.SetOnDrawItem(const Value: TOnDrawItem);\r
5785 begin\r
5786   asm\r
5787     jmp @@e_signature\r
5788     DB '#$signature$#', 0\r
5789     DB 'TKOLCustomControl.SetOnDrawItem', 0\r
5790   @@e_signature:\r
5791   end;\r
5792   FOnDrawItem := Value;\r
5793   Change;\r
5794 end;\r
5795 \r
5796 procedure TKOLCustomControl.SetOnDropDown(const Value: TOnEvent);\r
5797 begin\r
5798   asm\r
5799     jmp @@e_signature\r
5800     DB '#$signature$#', 0\r
5801     DB 'TKOLCustomControl.SetOnDropDown', 0\r
5802   @@e_signature:\r
5803   end;\r
5804   FOnDropDown := Value;\r
5805   Change;\r
5806 end;\r
5807 \r
5808 procedure TKOLCustomControl.SetOnDropFiles(const Value: TOnDropFiles);\r
5809 begin\r
5810   asm\r
5811     jmp @@e_signature\r
5812     DB '#$signature$#', 0\r
5813     DB 'TKOLCustomControl.SetOnDropFiles', 0\r
5814   @@e_signature:\r
5815   end;\r
5816   FOnDropFiles := Value;\r
5817   Change;\r
5818 end;\r
5819 \r
5820 procedure TKOLCustomControl.SetOnEndEditLVItem(const Value: TOnEditLVItem);\r
5821 begin\r
5822   asm\r
5823     jmp @@e_signature\r
5824     DB '#$signature$#', 0\r
5825     DB 'TKOLCustomControl.SetOnEndEditLVItem', 0\r
5826   @@e_signature:\r
5827   end;\r
5828   FOnEndEditLVItem := Value;\r
5829   Change;\r
5830 end;\r
5831 \r
5832 procedure TKOLCustomControl.SetOnEnter(const Value: TOnEvent);\r
5833 begin\r
5834   asm\r
5835     jmp @@e_signature\r
5836     DB '#$signature$#', 0\r
5837     DB 'TKOLCustomControl.SetOnEnter', 0\r
5838   @@e_signature:\r
5839   end;\r
5840   FOnEnter := Value;\r
5841   Change;\r
5842 end;\r
5843 \r
5844 procedure TKOLCustomControl.SetOnEraseBkgnd(const Value: TOnPaint);\r
5845 begin\r
5846   asm\r
5847     jmp @@e_signature\r
5848     DB '#$signature$#', 0\r
5849     DB 'TKOLCustomControl.SetOnEraseBkgnd', 0\r
5850   @@e_signature:\r
5851   end;\r
5852   FOnEraseBkgnd := Value;\r
5853   Change;\r
5854 end;\r
5855 \r
5856 procedure TKOLCustomControl.SetOnHide(const Value: TOnEvent);\r
5857 begin\r
5858   asm\r
5859     jmp @@e_signature\r
5860     DB '#$signature$#', 0\r
5861     DB 'TKOLCustomControl.SetOnHide', 0\r
5862   @@e_signature:\r
5863   end;\r
5864   FOnHide := Value;\r
5865   Change;\r
5866 end;\r
5867 \r
5868 procedure TKOLCustomControl.SetOnKeyDown(const Value: TOnKey);\r
5869 begin\r
5870   asm\r
5871     jmp @@e_signature\r
5872     DB '#$signature$#', 0\r
5873     DB 'TKOLCustomControl.SetOnKeyDown', 0\r
5874   @@e_signature:\r
5875   end;\r
5876   FOnKeyDown := Value;\r
5877   Change;\r
5878 end;\r
5879 \r
5880 procedure TKOLCustomControl.SetOnKeyUp(const Value: TOnKey);\r
5881 begin\r
5882   asm\r
5883     jmp @@e_signature\r
5884     DB '#$signature$#', 0\r
5885     DB 'TKOLCustomControl.SetOnKeyUp', 0\r
5886   @@e_signature:\r
5887   end;\r
5888   FOnKeyUp := Value;\r
5889   Change;\r
5890 end;\r
5891 \r
5892 procedure TKOLCustomControl.SetOnLeave(const Value: TOnEvent);\r
5893 begin\r
5894   asm\r
5895     jmp @@e_signature\r
5896     DB '#$signature$#', 0\r
5897     DB 'TKOLCustomControl.SetOnLeave', 0\r
5898   @@e_signature:\r
5899   end;\r
5900   FOnLeave := Value;\r
5901   Change;\r
5902 end;\r
5903 \r
5904 procedure TKOLCustomControl.SetOnLVData(const Value: TOnLVData);\r
5905 begin\r
5906   asm\r
5907     jmp @@e_signature\r
5908     DB '#$signature$#', 0\r
5909     DB 'TKOLCustomControl.SetOnLVData', 0\r
5910   @@e_signature:\r
5911   end;\r
5912   FOnLVData := Value;\r
5913   Change;\r
5914 end;\r
5915 \r
5916 procedure TKOLCustomControl.SetOnLVStateChange(const Value: TOnLVStateChange);\r
5917 begin\r
5918   asm\r
5919     jmp @@e_signature\r
5920     DB '#$signature$#', 0\r
5921     DB 'TKOLCustomControl.SetOnLVStateChange', 0\r
5922   @@e_signature:\r
5923   end;\r
5924   FOnLVStateChange := Value;\r
5925   Change;\r
5926 end;\r
5927 \r
5928 procedure TKOLCustomControl.SetOnMeasureItem(const Value: TOnMeasureItem);\r
5929 begin\r
5930   asm\r
5931     jmp @@e_signature\r
5932     DB '#$signature$#', 0\r
5933     DB 'TKOLCustomControl.SetOnMeasureItem', 0\r
5934   @@e_signature:\r
5935   end;\r
5936   FOnMeasureItem := Value;\r
5937   Change;\r
5938 end;\r
5939 \r
5940 procedure TKOLCustomControl.SetOnMessage(const Value: TOnMessage);\r
5941 begin\r
5942   asm\r
5943     jmp @@e_signature\r
5944     DB '#$signature$#', 0\r
5945     DB 'TKOLCustomControl.SetOnMessage', 0\r
5946   @@e_signature:\r
5947   end;\r
5948   FOnMessage := Value;\r
5949   Change;\r
5950 end;\r
5951 \r
5952 procedure TKOLCustomControl.SetOnMouseDblClk(const Value: TOnMouse);\r
5953 begin\r
5954   asm\r
5955     jmp @@e_signature\r
5956     DB '#$signature$#', 0\r
5957     DB 'TKOLCustomControl.SetOnMouseDblClk', 0\r
5958   @@e_signature:\r
5959   end;\r
5960   fOnMouseDblClk := Value;\r
5961   Change;\r
5962 end;\r
5963 \r
5964 procedure TKOLCustomControl.SetOnMouseDown(const Value: TOnMouse);\r
5965 begin\r
5966   asm\r
5967     jmp @@e_signature\r
5968     DB '#$signature$#', 0\r
5969     DB 'TKOLCustomControl.SetOnMouseDown', 0\r
5970   @@e_signature:\r
5971   end;\r
5972   FOnMouseDown := Value;\r
5973   Change;\r
5974 end;\r
5975 \r
5976 procedure TKOLCustomControl.SetOnMouseEnter(const Value: TOnEvent);\r
5977 begin\r
5978   asm\r
5979     jmp @@e_signature\r
5980     DB '#$signature$#', 0\r
5981     DB 'TKOLCustomControl.SetOnMouseEnter', 0\r
5982   @@e_signature:\r
5983   end;\r
5984   FOnMouseEnter := Value;\r
5985   Change;\r
5986 end;\r
5987 \r
5988 procedure TKOLCustomControl.SetOnMouseLeave(const Value: TOnEvent);\r
5989 begin\r
5990   asm\r
5991     jmp @@e_signature\r
5992     DB '#$signature$#', 0\r
5993     DB 'TKOLCustomControl.SetOnMouseLeave', 0\r
5994   @@e_signature:\r
5995   end;\r
5996   FOnMouseLeave := Value;\r
5997   Change;\r
5998 end;\r
5999 \r
6000 procedure TKOLCustomControl.SetOnMouseMove(const Value: TOnMouse);\r
6001 begin\r
6002   asm\r
6003     jmp @@e_signature\r
6004     DB '#$signature$#', 0\r
6005     DB 'TKOLCustomControl.SetOnMouseMove', 0\r
6006   @@e_signature:\r
6007   end;\r
6008   FOnMouseMove := Value;\r
6009   Change;\r
6010 end;\r
6011 \r
6012 procedure TKOLCustomControl.SetOnMouseUp(const Value: TOnMouse);\r
6013 begin\r
6014   asm\r
6015     jmp @@e_signature\r
6016     DB '#$signature$#', 0\r
6017     DB 'TKOLCustomControl.SetOnMouseUp', 0\r
6018   @@e_signature:\r
6019   end;\r
6020   FOnMouseUp := Value;\r
6021   Change;\r
6022 end;\r
6023 \r
6024 procedure TKOLCustomControl.SetOnMouseWheel(const Value: TOnMouse);\r
6025 begin\r
6026   asm\r
6027     jmp @@e_signature\r
6028     DB '#$signature$#', 0\r
6029     DB 'TKOLCustomControl.SetOnMouseWheel', 0\r
6030   @@e_signature:\r
6031   end;\r
6032   FOnMouseWheel := Value;\r
6033   Change;\r
6034 end;\r
6035 \r
6036 procedure TKOLCustomControl.SetOnMove(const Value: TOnEvent);\r
6037 begin\r
6038   asm\r
6039     jmp @@e_signature\r
6040     DB '#$signature$#', 0\r
6041     DB 'TKOLCustomControl.SetOnMove', 0\r
6042   @@e_signature:\r
6043   end;\r
6044   FOnMove := Value;\r
6045   Change;\r
6046 end;\r
6047 \r
6048 procedure TKOLCustomControl.SetOnPaint(const Value: TOnPaint);\r
6049 begin\r
6050   asm\r
6051     jmp @@e_signature\r
6052     DB '#$signature$#', 0\r
6053     DB 'TKOLCustomControl.SetOnPaint', 0\r
6054   @@e_signature:\r
6055   end;\r
6056   FOnPaint := Value;\r
6057   Change;\r
6058 end;\r
6059 \r
6060 procedure TKOLCustomControl.SetOnProgress(const Value: TOnEvent);\r
6061 begin\r
6062   asm\r
6063     jmp @@e_signature\r
6064     DB '#$signature$#', 0\r
6065     DB 'TKOLCustomControl.SetOnProgress', 0\r
6066   @@e_signature:\r
6067   end;\r
6068   FOnProgress := Value;\r
6069   Change;\r
6070 end;\r
6071 \r
6072 procedure TKOLCustomControl.SetOnResize(const Value: TOnEvent);\r
6073 begin\r
6074   asm\r
6075     jmp @@e_signature\r
6076     DB '#$signature$#', 0\r
6077     DB 'TKOLCustomControl.SetOnResize', 0\r
6078   @@e_signature:\r
6079   end;\r
6080   FOnResize := Value;\r
6081   Change;\r
6082 end;\r
6083 \r
6084 procedure TKOLCustomControl.SetOnRE_InsOvrMode_Change(const Value: TOnEvent);\r
6085 begin\r
6086   asm\r
6087     jmp @@e_signature\r
6088     DB '#$signature$#', 0\r
6089     DB 'TKOLCustomControl.SetOnRE_InsOvrMode_Change', 0\r
6090   @@e_signature:\r
6091   end;\r
6092   FOnRE_InsOvrMode_Change := Value;\r
6093   Change;\r
6094 end;\r
6095 \r
6096 procedure TKOLCustomControl.SetOnRE_OverURL(const Value: TOnEvent);\r
6097 begin\r
6098   asm\r
6099     jmp @@e_signature\r
6100     DB '#$signature$#', 0\r
6101     DB 'TKOLCustomControl.SetOnRE_OverURL', 0\r
6102   @@e_signature:\r
6103   end;\r
6104   FOnRE_OverURL := Value;\r
6105   Change;\r
6106 end;\r
6107 \r
6108 procedure TKOLCustomControl.SetOnRE_URLClick(const Value: TOnEvent);\r
6109 begin\r
6110   asm\r
6111     jmp @@e_signature\r
6112     DB '#$signature$#', 0\r
6113     DB 'TKOLCustomControl.SetOnRE_URLClick', 0\r
6114   @@e_signature:\r
6115   end;\r
6116   FOnRE_URLClick := Value;\r
6117   Change;\r
6118 end;\r
6119 \r
6120 procedure TKOLCustomControl.SetOnSelChange(const Value: TOnEvent);\r
6121 begin\r
6122   asm\r
6123     jmp @@e_signature\r
6124     DB '#$signature$#', 0\r
6125     DB 'TKOLCustomControl.SetOnSelChange', 0\r
6126   @@e_signature:\r
6127   end;\r
6128   FOnSelChange := Value;\r
6129   Change;\r
6130 end;\r
6131 \r
6132 procedure TKOLCustomControl.SetOnShow(const Value: TOnEvent);\r
6133 begin\r
6134   asm\r
6135     jmp @@e_signature\r
6136     DB '#$signature$#', 0\r
6137     DB 'TKOLCustomControl.SetOnShow', 0\r
6138   @@e_signature:\r
6139   end;\r
6140   FOnShow := Value;\r
6141   Change;\r
6142 end;\r
6143 \r
6144 procedure TKOLCustomControl.SetOnSplit(const Value: TOnSplit);\r
6145 begin\r
6146   asm\r
6147     jmp @@e_signature\r
6148     DB '#$signature$#', 0\r
6149     DB 'TKOLCustomControl.SetOnSplit', 0\r
6150   @@e_signature:\r
6151   end;\r
6152   FOnSplit := Value;\r
6153   Change;\r
6154 end;\r
6155 \r
6156 procedure TKOLCustomControl.SetOnTBDropDown(const Value: TOnEvent);\r
6157 begin\r
6158   asm\r
6159     jmp @@e_signature\r
6160     DB '#$signature$#', 0\r
6161     DB 'TKOLCustomControl.SetOnTBDropDown', 0\r
6162   @@e_signature:\r
6163   end;\r
6164   FOnTBDropDown := Value;\r
6165   Change;\r
6166 end;\r
6167 \r
6168 procedure TKOLCustomControl.SetOnTVBeginDrag(const Value: TOnTVBeginDrag);\r
6169 begin\r
6170   asm\r
6171     jmp @@e_signature\r
6172     DB '#$signature$#', 0\r
6173     DB 'TKOLCustomControl.SetOnTVBeginDrag', 0\r
6174   @@e_signature:\r
6175   end;\r
6176   FOnTVBeginDrag := Value;\r
6177   Change;\r
6178 end;\r
6179 \r
6180 procedure TKOLCustomControl.SetOnTVBeginEdit(const Value: TOnTVBeginEdit);\r
6181 begin\r
6182   asm\r
6183     jmp @@e_signature\r
6184     DB '#$signature$#', 0\r
6185     DB 'TKOLCustomControl.SetOnTVBeginEdit', 0\r
6186   @@e_signature:\r
6187   end;\r
6188   FOnTVBeginEdit := Value;\r
6189   Change;\r
6190 end;\r
6191 \r
6192 procedure TKOLCustomControl.SetOnTVDelete(const Value: TOnTVDelete);\r
6193 begin\r
6194   asm\r
6195     jmp @@e_signature\r
6196     DB '#$signature$#', 0\r
6197     DB 'TKOLCustomControl.SetOnTVDelete', 0\r
6198   @@e_signature:\r
6199   end;\r
6200   FOnTVDelete := Value;\r
6201   Change;\r
6202 end;\r
6203 \r
6204 procedure TKOLCustomControl.SetOnTVEndEdit(const Value: TOnTVEndEdit);\r
6205 begin\r
6206   asm\r
6207     jmp @@e_signature\r
6208     DB '#$signature$#', 0\r
6209     DB 'TKOLCustomControl.SetOnTVEndEdit', 0\r
6210   @@e_signature:\r
6211   end;\r
6212   FOnTVEndEdit := Value;\r
6213   Change;\r
6214 end;\r
6215 \r
6216 procedure TKOLCustomControl.SetOnTVExpanded(const Value: TOnTVExpanded);\r
6217 begin\r
6218   asm\r
6219     jmp @@e_signature\r
6220     DB '#$signature$#', 0\r
6221     DB 'TKOLCustomControl.SetOnTVExpanded', 0\r
6222   @@e_signature:\r
6223   end;\r
6224   FOnTVExpanded := Value;\r
6225   Change;\r
6226 end;\r
6227 \r
6228 procedure TKOLCustomControl.SetOnTVExpanding(const Value: TOnTVExpanding);\r
6229 begin\r
6230   asm\r
6231     jmp @@e_signature\r
6232     DB '#$signature$#', 0\r
6233     DB 'TKOLCustomControl.SetOnTVExpanding', 0\r
6234   @@e_signature:\r
6235   end;\r
6236   FOnTVExpanding := Value;\r
6237   Change;\r
6238 end;\r
6239 \r
6240 procedure TKOLCustomControl.SetOnTVSelChanging(const Value: TOnTVSelChanging);\r
6241 begin\r
6242   asm\r
6243     jmp @@e_signature\r
6244     DB '#$signature$#', 0\r
6245     DB 'TKOLCustomControl.SetOnTVSelChanging', 0\r
6246   @@e_signature:\r
6247   end;\r
6248   FOnTVSelChanging := Value;\r
6249   Change;\r
6250 end;\r
6251 \r
6252 procedure TKOLCustomControl.SetParent(Value: TWinControl);\r
6253 {var KF: TKOLForm;\r
6254     KC: TKOLCustomControl;}\r
6255 var PF: TKOLFont;\r
6256     PT: TPaintType;\r
6257     CodeAddr: procedure of object;\r
6258 begin\r
6259   asm\r
6260     jmp @@e_signature\r
6261     DB '#$signature$#', 0\r
6262     DB 'TKOLCustomControl.SetParent', 0\r
6263   @@e_signature:\r
6264   end;\r
6265   Log( '->TKOLCustomControl.SetParent' );\r
6266   try\r
6267 \r
6268   //Log( '1 - inherited' );\r
6269   inherited;\r
6270   //Log( '2 - inherited' );\r
6271   if Value <> nil then\r
6272   if (Value is TKOLCustomControl) or (Value is TForm) then\r
6273   begin\r
6274     if FParentColor then\r
6275     begin\r
6276       {if Value is TForm then\r
6277       begin\r
6278         KF := ParentKOLForm;\r
6279         if KF <> nil then\r
6280           Color := KF.Color;\r
6281       end\r
6282         else\r
6283       begin\r
6284         KC := Value as TKOLCustomControl;\r
6285         if KC <> nil then\r
6286           Color := KC.Color;\r
6287       end;}\r
6288     end;\r
6289     if FParentFont then\r
6290     begin\r
6291       {if Value is TForm then\r
6292       begin\r
6293         KF := ParentKOLForm;\r
6294         FFont.Assign( KF.Font );\r
6295       end\r
6296         else\r
6297       begin\r
6298         KC := Value as TKOLCustomControl;\r
6299         FFont.Assign( KC.Font );\r
6300       end;}\r
6301     end;\r
6302     //Font.Assign(RunTimeFont); {YS}\r
6303     //Log( '1 - Get_ParentFont' );\r
6304     PF := Get_ParentFont;\r
6305     //Log( '2 - Get_ParentFont' );\r
6306     Font.Assign(PF); {YS}\r
6307     //Log( '3 - Get_ParentFont' );\r
6308   end;\r
6309 {YS}\r
6310   {$IFDEF _KOLCtrlWrapper_}\r
6311   //Log( '1 - PaintType' );\r
6312   PT := PaintType;\r
6313   //Log( '2 - PaintType - AllowSelfPaint' );\r
6314   FAllowSelfPaint := PT in [ptWYSIWIG, ptWYSIWIGFrames];\r
6315   //Log( '3 - AllowSelfPaint - AllowCustomPaint' );\r
6316   FAllowCustomPaint:=PT <> ptWYSIWIG;\r
6317   //Log( '4 - AllowCustomPaint' );\r
6318   {$ENDIF}\r
6319 {YS}\r
6320   //Log( '5 - Change, Self=$' + Int2Hex( DWORD( Self ), 6 ) );\r
6321   CodeAddr := Change;\r
6322   //Log( '6 - Change Addr: $' + Int2Hex( DWORD( TMethod( CodeAddr ).Code ), 6 ) );\r
6323   TRY\r
6324     Change;\r
6325   EXCEPT on E: Exception do\r
6326          Log( 'Exception: ' + E.Message );\r
6327   END;\r
6328   //Log( '6 - Change' );\r
6329 \r
6330   LogOK;\r
6331   finally\r
6332   Log( '<-TKOLCustomControl.SetParent' );\r
6333   end;\r
6334 end;\r
6335 \r
6336 procedure TKOLCustomControl.SetparentColor(const Value: Boolean);\r
6337 begin\r
6338   asm\r
6339     jmp @@e_signature\r
6340     DB '#$signature$#', 0\r
6341     DB 'TKOLCustomControl.SetparentColor', 0\r
6342   @@e_signature:\r
6343   end;\r
6344   Log( '->TKOLCustomControl.SetparentColor' );\r
6345   try\r
6346   FParentColor := Value;\r
6347   if Value then\r
6348   begin\r
6349     if (ParentKOLControl = ParentKOLForm) and (ParentKOLForm <> nil) then\r
6350       Color := ParentKOLForm.Color\r
6351     else\r
6352     if ParentKOLControl <> nil then\r
6353       Color := (ParentKOLControl as TKOLCustomControl).Color;\r
6354   end;\r
6355   LogOK;\r
6356   finally\r
6357   Log( '<-TKOLCustomControl.SetparentColor' );\r
6358   end;\r
6359 end;\r
6360 \r
6361 procedure TKOLCustomControl.SetParentFont(const Value: Boolean);\r
6362 begin\r
6363   asm\r
6364     jmp @@e_signature\r
6365     DB '#$signature$#', 0\r
6366     DB 'TKOLCustomControl.SetParentFont', 0\r
6367   @@e_signature:\r
6368   end;\r
6369   Log( '->TKOLCustomControl.SetParentFont' );\r
6370   try\r
6371   FParentFont := Value;\r
6372   if Value then\r
6373   begin\r
6374     if FFont = nil then Exit;\r
6375     if (ParentKOLControl = ParentKOLForm) and (ParentKOLForm <> nil) then\r
6376       Font.Assign( ParentKOLForm.Font )\r
6377     else\r
6378     if ParentKOLControl <> nil then\r
6379       Font.Assign( (ParentKOLControl as TKOLCustomControl).Font );\r
6380   end;\r
6381   LogOK;\r
6382   finally\r
6383   Log( '<-TKOLCustomControl.SetParentFont' );\r
6384   end;\r
6385 end;\r
6386 \r
6387 procedure TKOLCustomControl.SetPlaceDown(const Value: Boolean);\r
6388 var R: TRect;\r
6389     M: Integer;\r
6390 begin\r
6391   asm\r
6392     jmp @@e_signature\r
6393     DB '#$signature$#', 0\r
6394     DB 'TKOLCustomControl.SetPlaceDown', 0\r
6395   @@e_signature:\r
6396   end;\r
6397   Log( '->TKOLCustomControl.SetPlaceDown' );\r
6398   try\r
6399   if (fAlign <> caNone) and Value then\r
6400   begin\r
6401     LogOK;\r
6402     Exit;\r
6403   end;\r
6404   fPlaceDown := Value;\r
6405   if Value then\r
6406   begin\r
6407     fPlaceRight := False;\r
6408     fPlaceUnder := False;\r
6409     fCenterOnParent := False;\r
6410     if not (csLoading in ComponentState) then\r
6411     begin\r
6412       R := PrevBounds;\r
6413       M := ParentMargin;\r
6414       Left := M;\r
6415       Top := R.Bottom + M;\r
6416     end;\r
6417   end;\r
6418   Change;\r
6419   LogOK;\r
6420   finally\r
6421   Log( '<-TKOLCustomControl.SetPlaceDown' );\r
6422   end;\r
6423 end;\r
6424 \r
6425 procedure TKOLCustomControl.SetPlaceRight(const Value: Boolean);\r
6426 var R: TRect;\r
6427     M: Integer;\r
6428 begin\r
6429   asm\r
6430     jmp @@e_signature\r
6431     DB '#$signature$#', 0\r
6432     DB 'TKOLCustomControl.SetPlaceRight', 0\r
6433   @@e_signature:\r
6434   end;\r
6435   Log( '->TKOLCustomControl.SetPlaceRight' );\r
6436   try\r
6437   if (fAlign <> caNone) and Value then\r
6438   begin\r
6439     LogOK;\r
6440     Exit;\r
6441   end;\r
6442   fPlaceRight := Value;\r
6443   if Value then\r
6444   begin\r
6445     fPlaceDown := False;\r
6446     fPlaceUnder := False;\r
6447     fCenterOnParent := False;\r
6448     if not (csLoading in ComponentState) then\r
6449     begin\r
6450       R := PrevBounds;\r
6451       M := ParentMargin;\r
6452       Left := R.Right + M;\r
6453       Top := R.Top;\r
6454     end;\r
6455   end;\r
6456   Change;\r
6457   LogOK;\r
6458   finally\r
6459   Log( '<-TKOLCustomControl.SetPlaceRight' );\r
6460   end;\r
6461 end;\r
6462 \r
6463 procedure TKOLCustomControl.SetPlaceUnder(const Value: Boolean);\r
6464 var R: TRect;\r
6465     M: Integer;\r
6466 begin\r
6467   asm\r
6468     jmp @@e_signature\r
6469     DB '#$signature$#', 0\r
6470     DB 'TKOLCustomControl.SetPlaceUnder', 0\r
6471   @@e_signature:\r
6472   end;\r
6473   Log( '->TKOLCustomControl.SetPlaceUnder' );\r
6474   try\r
6475   if (fAlign <> caNone) and Value then\r
6476   begin\r
6477     LogOK;\r
6478     Exit;\r
6479   end;\r
6480   fPlaceUnder := Value;\r
6481   if Value then\r
6482   begin\r
6483     fPlaceDown := False;\r
6484     fPlaceRight := False;\r
6485     fCenterOnParent := False;\r
6486     if not (csLoading in ComponentState) then\r
6487     begin\r
6488       R := PrevBounds;\r
6489       M := ParentMargin;\r
6490       Left := R.Left;\r
6491       Top := R.Bottom + M;\r
6492     end;\r
6493   end;\r
6494   Change;\r
6495   LogOK;\r
6496   finally\r
6497   Log( '<-TKOLCustomControl.SetPlaceUnder' );\r
6498   end;\r
6499 end;\r
6500 \r
6501 procedure TKOLCustomControl.SetShadowDeep(const Value: Integer);\r
6502 begin\r
6503   asm\r
6504     jmp @@e_signature\r
6505     DB '#$signature$#', 0\r
6506     DB 'TKOLCustomControl.SetShadowDeep', 0\r
6507   @@e_signature:\r
6508   end;\r
6509   Log( '->TKOLCustomControl.SetShadowDeep' );\r
6510   try\r
6511   FShadowDeep := Value;\r
6512   Invalidate;\r
6513   Change;\r
6514   LogOK;\r
6515   finally\r
6516   Log( '<-TKOLCustomControl.SetShadowDeep' );\r
6517   end;\r
6518 end;\r
6519 \r
6520 procedure TKOLCustomControl.SetStyle(const Value: DWORD);\r
6521 begin\r
6522   asm\r
6523     jmp @@e_signature\r
6524     DB '#$signature$#', 0\r
6525     DB 'TKOLCustomControl.SetStyle', 0\r
6526   @@e_signature:\r
6527   end;\r
6528   Log( '->TKOLCustomControl.SetStyle' );\r
6529   try\r
6530   fStyle := Value;\r
6531   Change;\r
6532   LogOK;\r
6533   finally\r
6534   Log( '<-TKOLCustomControl.SetStyle' );\r
6535   end;\r
6536 end;\r
6537 \r
6538 procedure TKOLCustomControl.SetTabOrder(const Value: Integer);\r
6539 var K, C: TComponent;\r
6540     I, Old, N, MinIdx: Integer;\r
6541     L: TList;\r
6542     kC, kMin: TKOLCustomControl;\r
6543     Found: Boolean;\r
6544 begin\r
6545   asm\r
6546     jmp @@e_signature\r
6547     DB '#$signature$#', 0\r
6548     DB 'TKOLCustomControl.SetTabOrder', 0\r
6549   @@e_signature:\r
6550   end;\r
6551   Log( '->TKOLCustomControl.SetTabOrder' );\r
6552   try\r
6553   Old := FTabOrder;\r
6554   FTabOrder := Value;\r
6555   if FTabOrder < -2 then\r
6556     FTabOrder := -1;\r
6557   if FTabOrder > 100000 then\r
6558     FTabOrder := 100000;\r
6559   if FTabOrder >= 0 then\r
6560   if not(csLoading in ComponentState) and not FAdjustingTabOrder then\r
6561   begin\r
6562     FAdjustingTabOrder := TRUE;\r
6563     TRY\r
6564 \r
6565       L := TList.Create;\r
6566       K := ParentForm;\r
6567       if K <> nil then\r
6568       try\r
6569         for I := 0 to K.ComponentCount - 1 do\r
6570         begin\r
6571           C := K.Components[ I ];\r
6572           //if C = Self then continue;\r
6573           if not( C is TKOLCustomControl ) then continue;\r
6574           kC := C as TKOLCustomControl;\r
6575           if kC.Parent <> Parent then continue;\r
6576           L.Add( kC );\r
6577         end;\r
6578         // 1. Move TabOrder for all controls with TabOrder >= Value up.\r
6579         // 1. Ïåðåìåñòèòü TabOrder äëÿ âñåõ, êòî èìååò òàêîé æå è âûøå, íà 1 ââåðõ.\r
6580         for I := 0 to L.Count - 1 do\r
6581         begin\r
6582           kC := L.Items[ I ];\r
6583           if kC = Self then continue;\r
6584           if kC.FTabOrder >= Value then\r
6585             Inc( kC.FTabOrder );\r
6586         end;\r
6587         // 2. "Squeeze" to prevent holes. (To prevent situation, when N, N+k,\r
6588         //    values are present and N+1 is not used).\r
6589         for N := 0 to L.Count - 1 do\r
6590         begin\r
6591           Found := FALSE;\r
6592           for I := 0 to L.Count - 1 do\r
6593           begin\r
6594             kC := L.Items[ I ];\r
6595             if kC.FTabOrder = N then\r
6596             begin\r
6597               Found := TRUE;\r
6598               break;\r
6599             end;\r
6600           end;\r
6601           if not Found then\r
6602           begin\r
6603             // Value N is not used as a TabOrder. Try to find next used TabOrder\r
6604             // value and move it to N.\r
6605             MinIdx := -1;\r
6606             for I := 0 to L.Count - 1 do\r
6607             begin\r
6608               kC := L.Items[ I ];\r
6609               if kC.FTabOrder > MaxInt div 4 - 1 then continue;\r
6610               if kC.FTabOrder < -MaxInt div 4 + 1 then continue;\r
6611               if (kC.FTabOrder > N) then\r
6612               begin\r
6613                 if (MinIdx >= 0) then\r
6614                 begin\r
6615                   kMin := L.Items[ MinIdx ];\r
6616                   if kC.FTabOrder < kMin.FTabOrder then\r
6617                     MinIdx := I;\r
6618                 end\r
6619                   else\r
6620                   MinIdx := I;\r
6621               end;\r
6622             end;\r
6623             if MinIdx < 0 then break;\r
6624             // Such TabOrder value found at control with MinIdx index in a list.\r
6625             kMin := L.Items[ MinIdx ];\r
6626             MinIdx := kMin.FTabOrder;\r
6627             for I := 0 to L.Count - 1 do\r
6628             begin\r
6629               kC := L.Items[ I ];\r
6630               if kC.FTabOrder > N then\r
6631               begin\r
6632                 kC.FTabOrder := kC.FTabOrder - (MinIdx - N);\r
6633                 //ShowMessage( kC.Name + '.TabOrder := ' + Int2Str( kC.TabOrder ) );\r
6634               end;\r
6635             end;\r
6636           end;\r
6637         end;\r
6638 \r
6639       finally\r
6640         L.Free;\r
6641       end;\r
6642     FINALLY\r
6643       FAdjustingTabOrder := FALSE;\r
6644     END;\r
6645   end;\r
6646   if Old <> FTabOrder then\r
6647     ReAlign( TRUE );\r
6648   Change;\r
6649   LogOK;\r
6650   finally\r
6651   Log( '<-TKOLCustomControl.SetTabOrder' );\r
6652   end;\r
6653 end;\r
6654 \r
6655 procedure TKOLCustomControl.SetTabStop(const Value: Boolean);\r
6656 {var K: TComponent;\r
6657     I, N: Integer;}\r
6658 begin\r
6659   asm\r
6660     jmp @@e_signature\r
6661     DB '#$signature$#', 0\r
6662     DB 'TKOLCustomControl.SetTabStop', 0\r
6663   @@e_signature:\r
6664   end;\r
6665   Log( '->TKOLCustomControl.SetTabStop' );\r
6666   try\r
6667   FTabStop := Value;\r
6668   Change;\r
6669   LogOK;\r
6670   finally\r
6671   Log( '<-TKOLCustomControl.SetTabStop' );\r
6672   end;\r
6673 end;\r
6674 \r
6675 procedure TKOLCustomControl.SetTag(const Value: Integer);\r
6676 begin\r
6677   asm\r
6678     jmp @@e_signature\r
6679     DB '#$signature$#', 0\r
6680     DB 'TKOLCustomControl.SetTag', 0\r
6681   @@e_signature:\r
6682   end;\r
6683   Log( '->TKOLCustomControl.SetTag' );\r
6684   TRY\r
6685   FTag := Value;\r
6686   Change;\r
6687   LogOK;\r
6688   finally\r
6689   Log( '<-TKOLCustomControl.SetTabStop' );\r
6690   end;\r
6691 end;\r
6692 \r
6693 procedure TKOLCustomControl.SetTextAlign(const Value: TTextAlign);\r
6694 begin\r
6695   asm\r
6696     jmp @@e_signature\r
6697     DB '#$signature$#', 0\r
6698     DB 'TKOLCustomControl.SetTextAlign', 0\r
6699   @@e_signature:\r
6700   end;\r
6701   Log( '->TKOLCustomControl.SetTextAlign' );\r
6702   try\r
6703   FTextAlign := Value;\r
6704 {YS}\r
6705   {$IFDEF _KOLCtrlWrapper_}\r
6706   if Assigned(FKOLCtrl) then\r
6707     FKOLCtrl.TextAlign:=kol.TTextAlign(Value);\r
6708   {$ENDIF}\r
6709 {YS}\r
6710   Invalidate;\r
6711   Change;\r
6712   LogOK;\r
6713   finally\r
6714   Log( '<-TKOLCustomControl.SetTextAlign' );\r
6715   end;\r
6716 end;\r
6717 \r
6718 function Color2Str( Color: TColor ): String;\r
6719 begin\r
6720   asm\r
6721     jmp @@e_signature\r
6722     DB '#$signature$#', 0\r
6723     DB 'Color2Str', 0\r
6724   @@e_signature:\r
6725   end;\r
6726   case Color of\r
6727   clScrollBar:             Result := 'clScrollBar';\r
6728   clBackground:            Result := 'clBackground';\r
6729   clActiveCaption:         Result := 'clActiveCaption';\r
6730   clInactiveCaption:       Result := 'clInactiveCaption';\r
6731   clMenu:                  Result := 'clMenu';\r
6732   clWindow:                Result := 'clWindow';\r
6733   clWindowFrame:           Result := 'clWindowFrame';\r
6734   clMenuText:              Result := 'clMenuText';\r
6735   clWindowText:            Result := 'clWindowText';\r
6736   clCaptionText:           Result := 'clCaptionText';\r
6737   clActiveBorder:          Result := 'clActiveBorder';\r
6738   clInactiveBorder:        Result := 'clInactiveBorder';\r
6739   clAppWorkSpace:          Result := 'clAppWorkSpace';\r
6740   clHighlight:             Result := 'clHighlight';\r
6741   clHighlightText:         Result := 'clHighlightText';\r
6742   clBtnFace:               Result := 'clBtnFace';\r
6743   clBtnShadow:             Result := 'clBtnShadow';\r
6744   clGrayText:              Result := 'clGrayText';\r
6745   clBtnText:               Result := 'clBtnText';\r
6746   clInactiveCaptionText:   Result := 'clInactiveCaptionText';\r
6747   clBtnHighlight:          Result := 'clBtnHighlight';\r
6748   cl3DDkShadow:            Result := 'cl3DDkShadow';\r
6749   cl3DLight:               Result := 'cl3DLight';\r
6750   clInfoText:              Result := 'clInfoText';\r
6751   clInfoBk:                Result := 'clInfoBk';\r
6752 \r
6753   clBlack:                 Result := 'clBlack';\r
6754   clMaroon:                Result := 'clMaroon';\r
6755   clGreen:                 Result := 'clGreen';\r
6756   clOlive:                 Result := 'clOlive';\r
6757   clNavy:                  Result := 'clNavy';\r
6758   clPurple:                Result := 'clPurple';\r
6759   clTeal:                  Result := 'clTeal';\r
6760   clGray:                  Result := 'clGray';\r
6761   clSilver:                Result := 'clSilver';\r
6762   clRed:                   Result := 'clRed';\r
6763   clLime:                  Result := 'clLime';\r
6764   clYellow:                Result := 'clYellow';\r
6765   clBlue:                  Result := 'clBlue';\r
6766   clFuchsia:               Result := 'clFuchsia';\r
6767   clAqua:                  Result := 'clAqua';\r
6768   //clLtGray:                Result := 'clLtGray';\r
6769   //clDkGray:                Result := 'clDkGray';\r
6770   clWhite:                 Result := 'clWhite';\r
6771   clNone:                  Result := 'clNone';\r
6772   clDefault:               Result := 'clDefault';\r
6773 \r
6774   else\r
6775     Result := '$' + Int2Hex( Color, 6 );\r
6776   end;\r
6777 end;\r
6778 \r
6779 procedure TKOLCustomControl.SetTransparent(const Value: Boolean);\r
6780 begin\r
6781   asm\r
6782     jmp @@e_signature\r
6783     DB '#$signature$#', 0\r
6784     DB 'TKOLCustomControl.SetTransparent', 0\r
6785   @@e_signature:\r
6786   end;\r
6787   FTransparent := Value;\r
6788   Invalidate;\r
6789   Change;\r
6790 end;\r
6791 \r
6792 procedure TKOLCustomControl.SetupColor(SL: TStrings; const AName: String);\r
6793 begin\r
6794   asm\r
6795     jmp @@e_signature\r
6796     DB '#$signature$#', 0\r
6797     DB 'TKOLCustomControl.SetupColor', 0\r
6798   @@e_signature:\r
6799   end;\r
6800   if (Brush.Bitmap = nil) or Brush.Bitmap.Empty then\r
6801   begin\r
6802     if Brush.BrushStyle <> bsSolid then\r
6803       Brush.GenerateCode( SL, AName )\r
6804     else\r
6805     begin\r
6806       if DefaultKOLParentColor and not parentColor or\r
6807          not DefaultKOLParentColor and (Color <> DefaultColor) then\r
6808         SL.Add( '    ' + AName + '.Color := ' + Color2Str( Color ) + ';' );\r
6809     end;\r
6810   end\r
6811     else\r
6812     Brush.GenerateCode( SL, AName );\r
6813 end;\r
6814 \r
6815 procedure TKOLCustomControl.SetupConstruct(SL: TStringList; const AName, AParent,\r
6816   Prefix: String);\r
6817 var S: String;\r
6818 begin\r
6819   asm\r
6820     jmp @@e_signature\r
6821     DB '#$signature$#', 0\r
6822     DB 'TKOLCustomControl.SetupConstruct', 0\r
6823   @@e_signature:\r
6824   end;\r
6825   Log( '->TKOLCustomControl.SetupConstruct' );\r
6826   try\r
6827   S := GenerateTransparentInits;\r
6828   SL.Add( Prefix + AName + ' := New' + TypeName + '( '\r
6829           + SetupParams( AName, AParent ) + ' )' + S + ';' );\r
6830   LogOK;\r
6831   finally\r
6832   Log( '<-TKOLCustomControl.SetupConstruct' );\r
6833   end;\r
6834 end;\r
6835 \r
6836 procedure TKOLCustomControl.SetupFirst(SL: TStringList; const AName,\r
6837   AParent, Prefix: String);\r
6838 const BoolVals: array[ Boolean ] of String = ( 'FALSE', 'TRUE' );\r
6839 begin\r
6840   asm\r
6841     jmp @@e_signature\r
6842     DB '#$signature$#', 0\r
6843     DB 'TKOLCustomControl.SetupFirst', 0\r
6844   @@e_signature:\r
6845   end;\r
6846   Log( '->TKOLCustomControl.SetupFirst' );\r
6847   try\r
6848 \r
6849   SetupConstruct( SL, AName, AParent, Prefix );\r
6850   if Tag <> 0 then\r
6851   begin\r
6852     if Tag < 0 then\r
6853       SL.Add( Prefix + AName + '.Tag := DWORD(' + IntToStr(Tag) + ');' )\r
6854     else\r
6855       SL.Add( Prefix + AName + '.Tag := ' + IntToStr(Tag) + ';' );\r
6856   end;\r
6857   if not Ctl3D then\r
6858     SL.Add( Prefix + AName + '.Ctl3D := False;' );\r
6859   if FHasBorder <> FDefHasBorder then\r
6860   begin\r
6861     SL.Add( Prefix + AName + '.HasBorder := ' + BoolVals[ FHasBorder ] + ';' );\r
6862     //ShowMessage( AName + '.HasBorder := ' + BoolVals[ FHasBorder ] );\r
6863   end;\r
6864   SetupTabOrder( SL, AName );\r
6865   SetupFont( SL, AName );\r
6866   SetupTextAlign( SL, AName );\r
6867   //SetupColor( SL, AName );\r
6868   if (csAcceptsControls in ControlStyle) or BorderNeeded then\r
6869   if (ParentKOLControl = ParentKOLForm) and (ParentKOLForm.Border <> Border)\r
6870   or (ParentKOLControl <> ParentKOLForm) and ((ParentKOLControl as TKOLCustomControl).Border <> Border) then\r
6871     SL.Add( Prefix + AName + '.Border := ' + IntToStr( Border ) + ';' );\r
6872   if MarginTop <> DefaultMarginTop then\r
6873     SL.Add( Prefix + AName + '.MarginTop := ' + IntToStr( MarginTop ) + ';' );\r
6874   if MarginBottom <> DefaultMarginBottom then\r
6875     SL.Add( Prefix + AName + '.MarginBottom := ' + IntToStr( MarginBottom ) + ';' );\r
6876   if MarginLeft <> DefaultMarginLeft then\r
6877     SL.Add( Prefix + AName + '.MarginLeft := ' + IntToStr( MarginLeft ) + ';' );\r
6878   if MarginRight <> DefaultMarginRight then\r
6879     SL.Add( Prefix + AName + '.MarginRight := ' + IntToStr( MarginRight ) + ';' );\r
6880   if not IsCursorDefault then\r
6881     if Copy( Cursor_, 1, 4 ) = 'IDC_' then\r
6882       SL.Add( Prefix + AName + '.Cursor := LoadCursor( 0, ' + Cursor_ + ' );' )\r
6883     else\r
6884       SL.Add( Prefix + AName + '.Cursor := LoadCursor( hInstance, ''' + Trim( Cursor_ ) + ''' );' );\r
6885   if not Visible and (Faction = nil) then\r
6886     SL.Add( Prefix + AName + '.Visible := False;' );\r
6887   if not Enabled and (Faction = nil) then\r
6888     SL.Add( Prefix + AName + '.Enabled := False;' );\r
6889   if DoubleBuffered and not Transparent then\r
6890     SL.Add( Prefix + AName + '.DoubleBuffered := True;' );\r
6891   if Owner <> nil then\r
6892   if Transparent and ((Owner is TKOLCustomControl) and not (Owner as TKOLCustomControl).Transparent or\r
6893      not(Owner is TKOLCustomControl) and not ParentKOLForm.Transparent) then\r
6894     SL.Add( Prefix + AName + '.Transparent := True;' );\r
6895   if Owner = nil then\r
6896   if Transparent then\r
6897     SL.Add( Prefix + AName + '.Transparent := TRUE;' );\r
6898   //AssignEvents( SL, AName );\r
6899   if EraseBackground then\r
6900     SL.Add( Prefix + AName + '.EraseBackground := TRUE;' );\r
6901   if MinWidth > 0 then\r
6902     SL.Add( Prefix + AName + '.MinWidth := ' + IntToStr( MinWidth ) + ';' );\r
6903   if MinHeight > 0 then\r
6904     SL.Add( Prefix + AName + '.MinHeight := ' + IntToStr( MinHeight ) + ';' );\r
6905   if MaxWidth > 0 then\r
6906     SL.Add( Prefix + AName + '.MaxWidth := ' + IntToStr( MaxWidth ) + ';' );\r
6907   if MaxHeight > 0 then\r
6908     SL.Add( Prefix + AName + '.MaxHeight := ' + IntToStr( MaxHeight ) + ';' );\r
6909   if IgnoreDefault <> FDefIgnoreDefault then\r
6910     SL.Add( Prefix + AName + '.IgnoreDefault := ' + BoolVals[ IgnoreDefault ] + ';' );\r
6911   //Rpt( '-------- FHint = ' + FHint );\r
6912   if (Trim( FHint ) <> '') and (Faction = nil) then\r
6913   begin\r
6914     if (ParentKOLForm <> nil) and ParentKOLForm.ShowHint then\r
6915       SL.Add( Prefix + AName + '.Hint.Text := ' + StringConstant( 'Hint', Hint ) + ';' );\r
6916     {else\r
6917       ShowMessage( 'ParentKOLForm=' + Int2Hex( Integer( Pointer( ParentKOLForm ) ), 8 ) );}\r
6918   end;\r
6919 \r
6920   LogOK;\r
6921   finally\r
6922   Log( '<-TKOLCustomControl.SetupFirst' );\r
6923   end;\r
6924 end;\r
6925 \r
6926 procedure TKOLCustomControl.SetupFont(SL: TStrings; const AName: String);\r
6927 var PFont: TKOLFont;\r
6928 begin\r
6929   asm\r
6930     jmp @@e_signature\r
6931     DB '#$signature$#', 0\r
6932     DB 'TKOLCustomControl.SetupFont', 0\r
6933   @@e_signature:\r
6934   end;\r
6935   Log( '->TKOLCustomControl.SetupFont' );\r
6936   try\r
6937   PFont := Get_ParentFont;\r
6938   //if (BFont = nil) or (BFont = Font) or not Font.Equal2( BFont ) then\r
6939   if not Font.Equal2( PFont ) then\r
6940     Font.GenerateCode( SL, AName, PFont );\r
6941   LogOK;\r
6942   finally\r
6943   Log( '<-TKOLCustomControl.SetupFont' );\r
6944   end;\r
6945 end;\r
6946 \r
6947 procedure TKOLCustomControl.SetupLast(SL: TStringList; const AName,\r
6948   AParent, Prefix: String);\r
6949 begin\r
6950   asm\r
6951     jmp @@e_signature\r
6952     DB '#$signature$#', 0\r
6953     DB 'TKOLCustomControl.SetupLast', 0\r
6954   @@e_signature:\r
6955   end;\r
6956   //Log( '->TKOLCustomControl.SetupLast' );\r
6957   try\r
6958   SetupColor( SL, AName );\r
6959   AssignEvents( SL, AName );\r
6960   if fDefaultBtn then\r
6961     SL.Add( Prefix + AName + '.DefaultBtn := TRUE;' )\r
6962   else\r
6963   if fCancelBtn then\r
6964     SL.Add( Prefix + AName + '.CancelBtn := TRUE;' );\r
6965   //LogOK;\r
6966   finally\r
6967   //Log( '<-TKOLCustomControl.SetupLast' );\r
6968   end;\r
6969 end;\r
6970 \r
6971 function TKOLCustomControl.SetupParams(const AName, AParent: String): String;\r
6972 begin\r
6973   asm\r
6974     jmp @@e_signature\r
6975     DB '#$signature$#', 0\r
6976     DB 'TKOLCustomControl.SetupParams', 0\r
6977   @@e_signature:\r
6978   end;\r
6979   Result := AParent;\r
6980 end;\r
6981 \r
6982 procedure TKOLCustomControl.SetupTabOrder(SL: TStringList; const AName: String);\r
6983 {var K, C: TComponent;\r
6984     I, N: Integer;\r
6985     kC: TKOLCustomControl;}\r
6986     {\r
6987       Instead of assigning a value to TabOrder property, special creation order\r
6988       is provided correspondent to an order of tabulating the controls - while\r
6989       generating constructors for these.\r
6990 \r
6991       Âìåñòî ïðèñâàèâàíèÿ çíà÷åíèÿ ñâîéñòâó TabOrder, îáåñïå÷èâàåòñÿ îñîáûé\r
6992       ïîðÿäîê ãåíåðàöèè êîíñòðóêòîðîâ äëÿ âèçóàëüíûõ îáúåêòîâ, ïðè êîòîðîì\r
6993       TabOrder ïîëó÷àåòñÿ òàêîé, êàêîé íóæíî.\r
6994     }\r
6995 begin\r
6996   asm\r
6997     jmp @@e_signature\r
6998     DB '#$signature$#', 0\r
6999     DB 'TKOLCustomControl.SetupTabOrder', 0\r
7000   @@e_signature:\r
7001   end;\r
7002   Log( '->TKOLCustomControl.SetupTabOrder' );\r
7003   try\r
7004   if not TabStop and TabStopByDefault then\r
7005   begin\r
7006     if FResetTabStopByStyle then\r
7007       SL.Add( '    ' + AName + '.Style := ' + AName + '.Style and not WS_TABSTOP;' )\r
7008     else\r
7009       SL.Add( '    ' + AName + '.TabStop := FALSE;' );\r
7010   end;\r
7011   LogOK;\r
7012   finally\r
7013   Log( '<-TKOLCustomControl.SetupTabOrder' );\r
7014   end;\r
7015 end;\r
7016 \r
7017 procedure TKOLCustomControl.SetupTextAlign(SL: TStrings; const AName: String);\r
7018 begin\r
7019   asm\r
7020     jmp @@e_signature\r
7021     DB '#$signature$#', 0\r
7022     DB 'TKOLCustomControl.SetupTextAlign', 0\r
7023   @@e_signature:\r
7024   end;\r
7025   // nothing here\r
7026 end;\r
7027 \r
7028 procedure TKOLCustomControl.SetVerticalAlign(const Value: TVerticalAlign);\r
7029 begin\r
7030   asm\r
7031     jmp @@e_signature\r
7032     DB '#$signature$#', 0\r
7033     DB 'TKOLCustomControl.SetVerticalAlign', 0\r
7034   @@e_signature:\r
7035   end;\r
7036   FVerticalAlign := Value;\r
7037   Invalidate;\r
7038   Change;\r
7039 end;\r
7040 \r
7041 procedure TKOLCustomControl.Set_Color(const Value: TColor);\r
7042 var KF: TKOLForm;\r
7043     KC: TKOLCustomControl;\r
7044     C: TComponent;\r
7045 begin\r
7046   asm\r
7047     jmp @@e_signature\r
7048     DB '#$signature$#', 0\r
7049     DB 'TKOLCustomControl.Set_Color', 0\r
7050   @@e_signature:\r
7051   end;\r
7052   Log( '->TKOLCustomControl.Set_Color' );\r
7053   try\r
7054 \r
7055   if not CanChangeColor and (Value <> DefaultColor) then\r
7056   begin\r
7057     //ShowMessage( 'This control can not change Color value.' );\r
7058     LogOK;\r
7059     Exit;\r
7060   end;\r
7061   if not (csLoading in ComponentState) then\r
7062   begin\r
7063     C := ParentKOLControl;\r
7064     if C <> nil then\r
7065     if C is TKOLForm then\r
7066     begin\r
7067       KF := C as TKOLForm;\r
7068       if Value <> KF.Color then\r
7069         parentColor := FALSE;\r
7070     end\r
7071       else\r
7072     if C is TKOLCustomControl then\r
7073     begin\r
7074       KC := C as TKOLCustomControl;\r
7075       if Value <> KC.Color then\r
7076         parentColor := FALSE;\r
7077     end;\r
7078   end;\r
7079   CollectChildrenWithParentColor;\r
7080   Brush.Color := Value;\r
7081   inherited Color := Value;\r
7082 {YS}\r
7083   {$IFDEF _KOLCtrlWrapper_}\r
7084   if Assigned(FKOLCtrl) then\r
7085     FKOLCtrl.Color := Value;\r
7086   {$ENDIF}\r
7087 {YS}\r
7088   Invalidate;\r
7089   ApplyColorToChildren;\r
7090   Change;\r
7091   //if csLoading in ComponentState then\r
7092   //  FParentColor := DetectParentColor;\r
7093 \r
7094   LogOK;\r
7095   finally\r
7096   Log( '<-TKOLCustomControl.Set_Color' );\r
7097   end;\r
7098 end;\r
7099 \r
7100 procedure TKOLCustomControl.Set_Enabled(const Value: Boolean);\r
7101 begin\r
7102   asm\r
7103     jmp @@e_signature\r
7104     DB '#$signature$#', 0\r
7105     DB 'TKOLCustomControl.Set_Enabled', 0\r
7106   @@e_signature:\r
7107   end;\r
7108   Log( '->TKOLCustomControl.Set_Enabled' );\r
7109   try\r
7110   if inherited Enabled <> Value then\r
7111   begin\r
7112     if Faction = nil then\r
7113       inherited Enabled := Value\r
7114     else\r
7115       inherited Enabled := Faction.Enabled;\r
7116     Change;\r
7117   end;\r
7118   LogOK;\r
7119   finally\r
7120   Log( '<-TKOLCustomControl.Set_Enabled' );\r
7121   end;\r
7122 end;\r
7123 \r
7124 procedure TKOLCustomControl.Set_Visible(const Value: Boolean);\r
7125 begin\r
7126   asm\r
7127     jmp @@e_signature\r
7128     DB '#$signature$#', 0\r
7129     DB 'TKOLCustomControl.Set_Visible', 0\r
7130   @@e_signature:\r
7131   end;\r
7132   Log( '->TKOLCustomControl.Set_Visible' );\r
7133   try\r
7134   if inherited Visible <> Value then\r
7135   begin\r
7136     if Faction = nil then\r
7137       inherited Visible := Value\r
7138     else\r
7139       inherited Visible := Faction.Visible;\r
7140   end;\r
7141   Change;\r
7142   LogOK;\r
7143   finally\r
7144   Log( '<-TKOLCustomControl.Set_Visible' );\r
7145   end;\r
7146 end;\r
7147 \r
7148 function TKOLCustomControl.TypeName: String;\r
7149 begin\r
7150   asm\r
7151     jmp @@e_signature\r
7152     DB '#$signature$#', 0\r
7153     DB 'TKOLCustomControl.TypeName', 0\r
7154   @@e_signature:\r
7155   end;\r
7156   //Log( '->TKOLCustomControl.TypeName' );\r
7157   try\r
7158   Result := ClassName;\r
7159   if UpperCase( Copy( Result, 1, 4 ) ) = 'TKOL' then\r
7160     Result := Copy( Result, 5, Length( Result ) - 4 );\r
7161   //LogOK;\r
7162   finally\r
7163   //Log( '<-TKOLCustomControl.TypeName' );\r
7164   end;\r
7165 end;\r
7166 \r
7167 function TKOLCustomControl.TabStopByDefault: Boolean;\r
7168 begin\r
7169   asm\r
7170     jmp @@e_signature\r
7171     DB '#$signature$#', 0\r
7172     DB 'TKOLCustomControl.TabStopByDefault', 0\r
7173   @@e_signature:\r
7174   end;\r
7175   Result := FALSE;\r
7176 end;\r
7177 \r
7178 function TKOLCustomControl.FontPropName: String;\r
7179 begin\r
7180   asm\r
7181     jmp @@e_signature\r
7182     DB '#$signature$#', 0\r
7183     DB 'TKOLCustomControl.FontPropName', 0\r
7184   @@e_signature:\r
7185   end;\r
7186   Result := 'Font';\r
7187 end;\r
7188 \r
7189 procedure TKOLCustomControl.AfterFontChange( SL: TStrings; const AName, Prefix: String );\r
7190 begin\r
7191   asm\r
7192     jmp @@e_signature\r
7193     DB '#$signature$#', 0\r
7194     DB 'TKOLCustomControl.AfterFontChange', 0\r
7195   @@e_signature:\r
7196   end;\r
7197   //\r
7198 end;\r
7199 \r
7200 procedure TKOLCustomControl.BeforeFontChange( SL: TStrings; const AName, Prefix: String );\r
7201 begin\r
7202   asm\r
7203     jmp @@e_signature\r
7204     DB '#$signature$#', 0\r
7205     DB 'TKOLCustomControl.BeforeFontChange', 0\r
7206   @@e_signature:\r
7207   end;\r
7208   //\r
7209 end;\r
7210 \r
7211 procedure TKOLCustomControl.SetHasBorder(const Value: Boolean);\r
7212 var CodeAddr: procedure of object;\r
7213     CodeAddr1: procedure( const V: Boolean ) of object;\r
7214 begin\r
7215   asm\r
7216     jmp @@e_signature\r
7217     DB '#$signature$#', 0\r
7218     DB 'TKOLCustomControl.SetHasBorder', 0\r
7219   @@e_signature:\r
7220   end;\r
7221   Log( '->TKOLCustomControl.SetHasBorder' );\r
7222   try\r
7223   FHasBorder := Value;\r
7224 {YS}\r
7225   {$IFDEF _KOLCtrlWrapper_}\r
7226   if Assigned(FKOLCtrl) then\r
7227     FKOLCtrl.HasBorder:=Value;\r
7228   {$ENDIF}\r
7229 {YS}\r
7230   //Log( 'SetHasBorder - Change, Self=$' + Int2Hex( DWORD( Self ), 6 ) );\r
7231   CodeAddr := Change;\r
7232   //Log( 'SetHasBorder - Change Addr: $' + Int2Hex( DWORD( TMethod( CodeAddr ).Code ), 6 ) );\r
7233   CodeAddr1 := SetHasBorder;\r
7234   //Log( 'SetHasBorder = own Addr: $' + Int2Hex( DWORD( TMethod( CodeAddr1 ).code ), 6 ) );\r
7235   Change;\r
7236   Invalidate;\r
7237   LogOK;\r
7238   finally\r
7239   Log( '<-TKOLCustomControl.SetHasBorder' );\r
7240   end;\r
7241 end;\r
7242 \r
7243 procedure TKOLCustomControl.SetOnScroll(const Value: TOnScroll);\r
7244 begin\r
7245   asm\r
7246     jmp @@e_signature\r
7247     DB '#$signature$#', 0\r
7248     DB 'TKOLCustomControl.SetOnScroll', 0\r
7249   @@e_signature:\r
7250   end;\r
7251   FOnScroll := Value;\r
7252   Change;\r
7253 end;\r
7254 \r
7255 procedure TKOLCustomControl.SetEditTabChar(const Value: Boolean);\r
7256 begin\r
7257   asm\r
7258     jmp @@e_signature\r
7259     DB '#$signature$#', 0\r
7260     DB 'TKOLCustomControl.SetEditTabChar', 0\r
7261   @@e_signature:\r
7262   end;\r
7263   FEditTabChar := Value;\r
7264   WantTabs( Value );\r
7265   Change;\r
7266 end;\r
7267 \r
7268 procedure TKOLCustomControl.WantTabs( Want: Boolean );\r
7269 begin\r
7270   asm\r
7271     jmp @@e_signature\r
7272     DB '#$signature$#', 0\r
7273     DB 'TKOLCustomControl.WantTabs', 0\r
7274   @@e_signature:\r
7275   end;\r
7276 end;\r
7277 \r
7278 function TKOLCustomControl.CanNotChangeFontColor: Boolean;\r
7279 begin\r
7280   asm\r
7281     jmp @@e_signature\r
7282     DB '#$signature$#', 0\r
7283     DB 'TKOLCustomControl.CanNotChangeFontColor', 0\r
7284   @@e_signature:\r
7285   end;\r
7286   Result := FALSE;\r
7287 end;\r
7288 \r
7289 function TKOLCustomControl.DefaultColor: TColor;\r
7290 begin\r
7291   asm\r
7292     jmp @@e_signature\r
7293     DB '#$signature$#', 0\r
7294     DB 'TKOLCustomControl.DefaultColor', 0\r
7295   @@e_signature:\r
7296   end;\r
7297   Result := clBtnFace;\r
7298 end;\r
7299 \r
7300 function TKOLCustomControl.DefaultParentColor: Boolean;\r
7301 begin\r
7302   asm\r
7303     jmp @@e_signature\r
7304     DB '#$signature$#', 0\r
7305     DB 'TKOLCustomControl.DefaultParentColor', 0\r
7306   @@e_signature:\r
7307   end;\r
7308   Result := DefaultColor = clBtnFace;\r
7309 end;\r
7310 \r
7311 function TKOLCustomControl.DefaultInitialColor: TColor;\r
7312 begin\r
7313   asm\r
7314     jmp @@e_signature\r
7315     DB '#$signature$#', 0\r
7316     DB 'TKOLCustomControl.DefaultInitialColor', 0\r
7317   @@e_signature:\r
7318   end;\r
7319   Result := DefaultColor;\r
7320 end;\r
7321 \r
7322 function TKOLCustomControl.DefaultKOLParentColor: Boolean;\r
7323 begin\r
7324   asm\r
7325     jmp @@e_signature\r
7326     DB '#$signature$#', 0\r
7327     DB 'TKOLCustomControl.DefaultKOLParentColor', 0\r
7328   @@e_signature:\r
7329   end;\r
7330   Result := TRUE;\r
7331 end;\r
7332 \r
7333 function TKOLCustomControl.CanChangeColor: Boolean;\r
7334 begin\r
7335   asm\r
7336     jmp @@e_signature\r
7337     DB '#$signature$#', 0\r
7338     DB 'TKOLCustomControl.CanChangeColor', 0\r
7339   @@e_signature:\r
7340   end;\r
7341   Result := TRUE;\r
7342 end;\r
7343 \r
7344 function TKOLCustomControl.PaintType: TPaintType;\r
7345 begin\r
7346   asm\r
7347     jmp @@e_signature\r
7348     DB '#$signature$#', 0\r
7349     DB 'TKOLCustomControl.PaintType', 0\r
7350   @@e_signature:\r
7351   end;\r
7352   Log( '->TKOLCustomControl.PaintType' );\r
7353   try\r
7354   Result := ptWYSIWIG;\r
7355   if ParentKOLForm <> nil then\r
7356     Result := ParentKOLForm.PaintType;\r
7357   LogOK;\r
7358   finally\r
7359   Log( '<-TKOLCustomControl.PaintType' );\r
7360   end;\r
7361 end;\r
7362 \r
7363 function TKOLCustomControl.WYSIWIGPaintImplemented: Boolean;\r
7364 begin\r
7365   asm\r
7366     jmp @@e_signature\r
7367     DB '#$signature$#', 0\r
7368     DB 'TKOLCustomControl.WYSIWIGPaintImplemented', 0\r
7369   @@e_signature:\r
7370   end;\r
7371   Result := FALSE;\r
7372 end;\r
7373 \r
7374 function TKOLCustomControl.CompareFirst(c, n: string): boolean;\r
7375 begin\r
7376   asm\r
7377     jmp @@e_signature\r
7378     DB '#$signature$#', 0\r
7379     DB 'TKOLCustomControl.CompareFirst', 0\r
7380   @@e_signature:\r
7381   end;\r
7382   Result := FALSE;\r
7383 end;\r
7384 \r
7385 procedure TKOLCustomControl.PrepareCanvasFontForWYSIWIGPaint( ACanvas: TCanvas );\r
7386 //var RFont: TKOLFont;\r
7387 begin\r
7388   asm\r
7389     jmp @@e_signature\r
7390     DB '#$signature$#', 0\r
7391     DB 'TKOLCustomControl.PrepareCanvasFontForWYSIWIGPaint', 0\r
7392   @@e_signature:\r
7393   end;\r
7394   Log( '->TKOLCustomControl.PrepareCanvasFontForWYSIWIGPaint' );\r
7395   try\r
7396 \r
7397   TRY\r
7398 \r
7399     Rpt( 'Call RunTimeFont' ); //Rpt_Stack;\r
7400     //RFont := RunTimeFont;\r
7401 \r
7402     if not Font.Equal2(nil) then\r
7403     //if (RFont = Font) or not Font.Equal2( RFont ) then\r
7404     begin\r
7405       Rpt( 'Font different ! Color=' + Int2Hex( Color2RGB( Font.Color ), 8 ) );\r
7406       ACanvas.Font.Name:= Font.FontName;\r
7407       ACanvas.Font.Height:= Font.FontHeight;\r
7408       //ACanvas.Font.Color:= Font.Color;\r
7409       ACanvas.Font.Style:= TFontStyles( Font.FontStyle );\r
7410       {$IFNDEF _D2}\r
7411       ACanvas.Font.Charset:= Font.FontCharset;\r
7412       {$ENDIF}\r
7413       ACanvas.Font.Pitch:= Font.FontPitch;\r
7414     end\r
7415     else\r
7416       ACanvas.Font.Handle:=GetDefaultControlFont;\r
7417 \r
7418     ACanvas.Font.Color:= Font.Color;    // !!!!!!\r
7419     ACanvas.Brush.Color := Color;\r
7420 \r
7421   EXCEPT\r
7422     on E: Exception do\r
7423     begin\r
7424       ShowMessage( 'Can not prepare WYSIWIG font, exception: ' + E.Message );\r
7425     end;\r
7426 \r
7427   END;\r
7428 \r
7429   LogOK;\r
7430   finally\r
7431   Log( '<-TKOLCustomControl.PrepareCanvasFontForWYSIWIGPaint' );\r
7432   end;\r
7433 end;\r
7434 \r
7435 function TKOLCustomControl.NoDrawFrame: Boolean;\r
7436 begin\r
7437   asm\r
7438     jmp @@e_signature\r
7439     DB '#$signature$#', 0\r
7440     DB 'TKOLCustomControl.NoDrawFrame', 0\r
7441   @@e_signature:\r
7442   end;\r
7443   Result := FALSE;\r
7444 end;\r
7445 \r
7446 procedure TKOLCustomControl.ReAlign( ParentOnly: Boolean );\r
7447 var ParentK: TComponent;\r
7448     ParentF: TKOLForm;\r
7449 begin\r
7450   asm\r
7451     jmp @@e_signature\r
7452     DB '#$signature$#', 0\r
7453     DB 'TKOLCustomControl.ReAlign', 0\r
7454   @@e_signature:\r
7455   end;\r
7456   Log( '->TKOLCustomControl.ReAlign' );\r
7457   try\r
7458 \r
7459   if not (csLoading in ComponentState) then\r
7460   begin\r
7461     ParentF := ParentKOLForm;\r
7462     ParentK := ParentKOLControl;\r
7463     if (ParentK <> nil) and (ParentF <> nil) then\r
7464     begin\r
7465       if ParentK is TKOLForm then\r
7466         (ParentK as TKOLForm).AlignChildren( nil, FALSE )\r
7467       else\r
7468       if ParentK is TKOLCustomControl then\r
7469         if ParentF <> nil then\r
7470           ParentF.AlignChildren( ParentK as TKOLCustomControl, FALSE );\r
7471       if not ParentOnly then\r
7472         ParentF.AlignChildren( Self, FALSE );\r
7473     end\r
7474       else\r
7475       //Rpt( 'TKOLCustomControl.ReAlign -- did nothing' )\r
7476       ;\r
7477   end;\r
7478 \r
7479   LogOK;\r
7480   finally\r
7481   Log( '<-TKOLCustomControl.ReAlign' );\r
7482   end;\r
7483 end;\r
7484 \r
7485 procedure TKOLCustomControl.NotifyLinkedComponent(Sender: TObject;\r
7486   Operation: TNotifyOperation);\r
7487 begin\r
7488   asm\r
7489     jmp @@e_signature\r
7490     DB '#$signature$#', 0\r
7491     DB 'TKOLCustomControl.NotifyLinkedComponent', 0\r
7492   @@e_signature:\r
7493   end;\r
7494   Log( '->TKOLCustomControl.NotifyLinkedComponent' );\r
7495   try\r
7496   if Operation = noRemoved then\r
7497   if Assigned( fNotifyList ) then\r
7498     fNotifyList.Remove( Sender );\r
7499   Invalidate;\r
7500   LogOK;\r
7501   finally\r
7502   Log( '<-TKOLCustomControl.NotifyLinkedComponent' );\r
7503   end;\r
7504 end;\r
7505 \r
7506 procedure TKOLCustomControl.AddToNotifyList(Sender: TComponent);\r
7507 begin\r
7508   asm\r
7509     jmp @@e_signature\r
7510     DB '#$signature$#', 0\r
7511     DB 'TKOLCustomControl.AddToNotifyList', 0\r
7512   @@e_signature:\r
7513   end;\r
7514   Log( '->TKOLCustomControl.AddToNotifyList' );\r
7515   try\r
7516   if Assigned( fNotifyList ) then\r
7517   if fNotifyList.IndexOf( Sender ) < 0 then\r
7518     fNotifyList.Add( Sender );\r
7519   LogOK;\r
7520   finally\r
7521   Log( '<-TKOLCustomControl.AddToNotifyList' );\r
7522   end;\r
7523 end;\r
7524 \r
7525 procedure TKOLCustomControl.SetMaxHeight(const Value: Integer);\r
7526 begin\r
7527   FMaxHeight := Value;\r
7528   Change;\r
7529 end;\r
7530 \r
7531 procedure TKOLCustomControl.SetMaxWidth(const Value: Integer);\r
7532 begin\r
7533   FMaxWidth := Value;\r
7534   Change;\r
7535 end;\r
7536 \r
7537 procedure TKOLCustomControl.SetMinHeight(const Value: Integer);\r
7538 begin\r
7539   FMinHeight := Value;\r
7540   Change;\r
7541 end;\r
7542 \r
7543 procedure TKOLCustomControl.SetMinWidth(const Value: Integer);\r
7544 begin\r
7545   FMinWidth := Value;\r
7546   Change;\r
7547 end;\r
7548 \r
7549 procedure TKOLCustomControl.Loaded;\r
7550 begin\r
7551   Log( '->TKOLCustomControl.Loaded' );\r
7552   try\r
7553   inherited;\r
7554   CollectChildrenWithParentFont;\r
7555   Font.Change;\r
7556   if AutoSize then\r
7557     AutoSizeNow;\r
7558   LogOK;\r
7559   finally\r
7560   Log( '<-TKOLCustomControl.Loaded' );\r
7561   end;\r
7562 end;\r
7563 \r
7564 procedure TKOLCustomControl.DoGenerateConstants(SL: TStringList);\r
7565 begin\r
7566   //\r
7567 end;\r
7568 \r
7569 function TKOLCustomControl.AutoSizeRunTime: Boolean;\r
7570 begin\r
7571   Result := TRUE;\r
7572 end;\r
7573 \r
7574 procedure TKOLCustomControl.SetLocalizy(const Value: TLocalizyOptions);\r
7575 begin\r
7576   FLocalizy := Value;\r
7577   Change;\r
7578 end;\r
7579 \r
7580 function TKOLCustomControl.StringConstant(const Propname,\r
7581   Value: String): String;\r
7582 begin\r
7583   Log( '->TKOLCustomControl.StringConstant' );\r
7584   try\r
7585   if (Value <> '') AND\r
7586      ((Localizy = loForm) and (ParentKOLForm <> nil) and\r
7587      (ParentKOLForm.Localizy) or (Localizy = loYes)) then\r
7588   begin\r
7589     Result := ParentKOLForm.Name + '_' + Name + '_' + Propname;\r
7590     ParentKOLForm.MakeResourceString( Result, Value );\r
7591   end\r
7592     else\r
7593   begin\r
7594     Result := String2Pascal( Value );\r
7595   end;\r
7596   LogOK;\r
7597   finally\r
7598   Log( '<-TKOLCustomControl.StringConstant' );\r
7599   end;\r
7600 end;\r
7601 \r
7602 function PCharStringConstant(Sender: TObject; const Propname,\r
7603   Value: String): String;\r
7604 begin\r
7605   if Sender is TKOLCustomControl then\r
7606     Result := (Sender as TKOLCustomControl).StringConstant( Propname, Value )\r
7607   else\r
7608   if Sender is TKOLObj then\r
7609     Result := (Sender as TKOLObj).StringConstant( Propname, Value )\r
7610   else\r
7611   if Sender is TKOLForm then\r
7612     Result := (Sender as TKOLForm).StringConstant( PropName, Value )\r
7613   else\r
7614   begin\r
7615     Result := 'error';\r
7616     Exit;\r
7617   end;\r
7618   if Result <> '' then\r
7619     if Result[ 1 ] <> '''' then\r
7620       Result := 'PChar( ' + Result + ' )';\r
7621 end;\r
7622 \r
7623 procedure TKOLCustomControl.SetHelpContext(const Value: Integer);\r
7624 begin\r
7625   if FHelpContext1 = Value then Exit;\r
7626   if Faction = nil then\r
7627     FHelpContext1 := Value\r
7628   else\r
7629     FHelpContext1 := Faction.HelpContext;\r
7630   Change;\r
7631 end;\r
7632 \r
7633 procedure TKOLCustomControl.SetCancelBtn(const Value: Boolean);\r
7634 var F: TKOLForm;\r
7635 begin\r
7636   Log( '->TKOLCustomControl.SetCancelBtn' );\r
7637   try\r
7638   if FCancelBtn <> Value then\r
7639   begin\r
7640     FCancelBtn := Value;\r
7641     if Value then\r
7642     begin\r
7643       DefaultBtn := FALSE;\r
7644       F := ParentKOLForm;\r
7645       if F <> nil then\r
7646       begin\r
7647         if (F.fCancelBtnCtl <> nil) and (F.fCancelBtnCtl <> Self) then\r
7648           F.fCancelBtnCtl.CancelBtn := FALSE;\r
7649         F.fCancelBtnCtl := Self;\r
7650       end;\r
7651     end;\r
7652     Change;\r
7653   end;\r
7654   LogOK;\r
7655   finally\r
7656   Log( '<-TKOLCustomControl.SetCancelBtn' );\r
7657   end;\r
7658 end;\r
7659 \r
7660 procedure TKOLCustomControl.SetDefaultBtn(const Value: Boolean);\r
7661 var F: TKOLForm;\r
7662 begin\r
7663   Log( '->TKOLCustomControl.SetDefaultBtn' );\r
7664   try\r
7665   if FDefaultBtn <> Value then\r
7666   begin\r
7667     FDefaultBtn := Value;\r
7668     if Value then\r
7669     begin\r
7670       CancelBtn := FALSE;\r
7671       F := ParentKOLForm;\r
7672       if F <> nil then\r
7673       begin\r
7674         if (F.fDefaultBtnCtl <> nil) and (F.FDefaultBtnCtl <> Self) then\r
7675           F.fDefaultBtnCtl.DefaultBtn := FALSE;\r
7676         F.fDefaultBtnCtl := Self;\r
7677       end;\r
7678     end;\r
7679     if Assigned(FKOLCtrl) then\r
7680       with FKOLCtrl^ do\r
7681         if FDefaultBtn then\r
7682           Style := Style or BS_DEFPUSHBUTTON\r
7683         else\r
7684           Style := Style and not BS_DEFPUSHBUTTON;\r
7685     Change;\r
7686   end;\r
7687   LogOK;\r
7688   finally\r
7689   Log( '<-TKOLCustomControl.SetDefaultBtn' );\r
7690   end;\r
7691 end;\r
7692 \r
7693 function TKOLCustomControl.Generate_SetSize: String;\r
7694 const BoolVals: array[ Boolean ] of String = ( 'FALSE', 'TRUE' );\r
7695 var W, H: Integer;\r
7696 begin\r
7697   Log( '->TKOLCustomControl.Generate_SetSize' );\r
7698   try\r
7699 \r
7700   W := 0;\r
7701   H := 0;\r
7702   if Align <> caClient then\r
7703   if (Width <> DefaultWidth) or (Height <> DefaultHeight) then\r
7704   begin\r
7705     if (Width <> DefaultWidth) and not (Align in [ caTop, caBottom ]) then\r
7706       W := Width;\r
7707     if (Height <> DefaultHeight) and not (Align in [ caLeft, caRight ]) then\r
7708       H := Height;\r
7709   end;\r
7710 \r
7711   if (AutoSize and AutoSizeRunTime) xor DefaultAutoSize then\r
7712     Result := Result + '.AutoSize( ' + BoolVals[ AutoSize ] + ' )';\r
7713 \r
7714   if IsGenerateSize then\r
7715   if not (autoSize and AutoSizeRunTime) or fNoAutoSizeX then\r
7716   begin\r
7717     if autoSize and AutoSizeRunTime then\r
7718       H := 0;\r
7719     if (W <> 0) or (H <> 0) then\r
7720       Result := Result + '.SetSize( ' + IntToStr( W ) + ', ' + IntToStr( H ) + ' )';\r
7721   end;\r
7722 \r
7723   LogOK;\r
7724   finally\r
7725   Log( '<-TKOLCustomControl.Generate_SetSize' );\r
7726   end;\r
7727 end;\r
7728 \r
7729 procedure TKOLCustomControl.SetIgnoreDefault(const Value: Boolean);\r
7730 begin\r
7731   FIgnoreDefault := Value;\r
7732   Change;\r
7733 end;\r
7734 \r
7735 procedure TKOLCustomControl.SetBrush(const Value: TKOLBrush);\r
7736 begin\r
7737   FBrush.Assign( Value );\r
7738   Change;\r
7739 end;\r
7740 \r
7741 function TKOLCustomControl.BorderNeeded: Boolean;\r
7742 begin\r
7743   Result := FALSE;\r
7744 end;\r
7745 \r
7746 procedure TKOLCustomControl.SetIsGenerateSize(const Value: Boolean);\r
7747 begin\r
7748   FIsGenerateSize := Value;\r
7749   Invalidate;\r
7750 end;\r
7751 \r
7752 procedure TKOLCustomControl.SetIsGeneratePosition(const Value: Boolean);\r
7753 begin\r
7754   FIsGeneratePosition := Value;\r
7755   Change;\r
7756 end;\r
7757 \r
7758 function TKOLCustomControl.BestEventName: String;\r
7759 begin\r
7760   Result := 'OnClick';\r
7761 end;\r
7762 \r
7763 procedure TKOLCustomControl.KOLControlRecreated;\r
7764 begin\r
7765 {$IFNDEF NOT_USE_KOLCTRLWRAPPER}\r
7766   Log( '->TKOLCustomControl.KOLControlRecreated' );\r
7767   try\r
7768   if Assigned(FKOLCtrl) then begin\r
7769     FKOLCtrl.Color:=Color;\r
7770     FKOLCtrl.Caption:=Caption;\r
7771     Font.Change;\r
7772     Brush.Change;\r
7773   end;\r
7774   LogOK;\r
7775   finally\r
7776   Log( '<-TKOLCustomControl.KOLControlRecreated' );\r
7777   end;\r
7778 {$ENDIF NOT_USE_KOLCTRLWRAPPER}\r
7779 end;\r
7780 \r
7781 function TKOLCustomControl.GetDefaultControlFont: HFONT;\r
7782 begin\r
7783   Result:=GetStockObject(SYSTEM_FONT);\r
7784 end;\r
7785 \r
7786 procedure TKOLCustomControl.SetHint(const Value: String);\r
7787 begin\r
7788   if FHint = Value then exit;\r
7789   if Faction = nil then\r
7790     FHint := Value\r
7791   else\r
7792     FHint := Faction.Hint;\r
7793   Change;\r
7794 end;\r
7795 \r
7796 function TKOLCustomControl.OwnerKOLForm(AOwner: TComponent): TKOLForm;\r
7797 var C, D: TComponent;\r
7798     I: Integer;\r
7799 begin\r
7800   asm\r
7801     jmp @@e_signature\r
7802     DB '#$signature$#', 0\r
7803     DB 'TKOLCustomControl.OwnerKOLForm', 0\r
7804   @@e_signature:\r
7805   end;\r
7806   Log( '->TKOLCustomControl.OwnerKOLForm' );\r
7807   try\r
7808   //Rpt( 'Where from TKOLCustomControl.OwnerKOLForm called?' );\r
7809   //Rpt_Stack;\r
7810 \r
7811   C := AOwner;\r
7812   Log( '*1 TKOLCustomControl.OwnerKOLForm' );\r
7813   while (C <> nil) and not(C is TForm) do\r
7814     C := C.Owner;\r
7815   Log( '*2 TKOLCustomControl.OwnerKOLForm' );\r
7816   Result := nil;\r
7817   if C <> nil then\r
7818   if C is TForm then\r
7819   begin\r
7820   Log( '*3 TKOLCustomControl.OwnerKOLForm' );\r
7821     for I := 0 to (C as TForm).ComponentCount - 1 do\r
7822     begin\r
7823       D := (C as TForm).Components[ I ];\r
7824       if D is TKOLForm then\r
7825       begin\r
7826         Result := D as TKOLForm;\r
7827         break;\r
7828       end;\r
7829     end;\r
7830   Log( '*4 TKOLCustomControl.OwnerKOLForm' );\r
7831   end;\r
7832 \r
7833   LogOK;\r
7834   finally\r
7835   Log( '<-TKOLCustomControl.OwnerKOLForm' );\r
7836   end;\r
7837 end;\r
7838 \r
7839 procedure TKOLCustomControl.DoNotifyLinkedComponents(\r
7840   Operation: TNotifyOperation);\r
7841 var I: Integer;\r
7842     C: TComponent;\r
7843 begin\r
7844   Log( '->TKOLCustomControl.DoNotifyLinkedComponents' );\r
7845   try\r
7846 \r
7847   if Assigned( fNotifyList ) then\r
7848     for I := fNotifyList.Count-1 downto 0 do\r
7849     begin\r
7850       C := fNotifyList[ I ];\r
7851       if C is TKOLObj then\r
7852         (C as TKOLObj).NotifyLinkedComponent( Self, Operation )\r
7853       else\r
7854       if C is TKOLCustomControl then\r
7855         (C as TKOLCustomControl).NotifyLinkedComponent( Self, Operation );\r
7856     end;\r
7857 \r
7858   LogOK;\r
7859   finally\r
7860   Log( '<-TKOLCustomControl.DoNotifyLinkedComponents' );\r
7861   end;\r
7862 end;\r
7863 \r
7864 function TKOLCustomControl.Get_ParentFont: TKOLFont;\r
7865 begin\r
7866   Log( '->TKOLCustomControl.Get_ParentFont' );\r
7867   try\r
7868   if (ParentKOLControl <> nil) then\r
7869   begin\r
7870     if ParentKOLControl = ParentKOLForm then\r
7871       Result := ParentKOLForm.Font\r
7872     else\r
7873       Result := (ParentKOLControl as TKOLCustomControl).Font;\r
7874   end\r
7875   else\r
7876     Result := nil;\r
7877   LogOK;\r
7878   finally\r
7879   Log( '<-TKOLCustomControl.Get_ParentFont' );\r
7880   end;\r
7881 end;\r
7882 \r
7883 {$IFDEF NOT_USE_KOLCTRLWRAPPER}\r
7884 procedure TKOLCustomControl.CreateKOLControl(Recreating: boolean);\r
7885 begin\r
7886   //\r
7887 end;\r
7888 \r
7889 procedure TKOLCustomControl.UpdateAllowSelfPaint;\r
7890 begin\r
7891   //\r
7892 end;\r
7893 {$ENDIF NOT_USE_KOLCTRLWRAPPER}\r
7894 \r
7895 procedure TKOLCustomControl.SetUnicode(const Value: Boolean);\r
7896 begin\r
7897   FUnicode := Value;\r
7898   Change;\r
7899 end;\r
7900 \r
7901 procedure TKOLCustomControl.Setaction(const Value: TKOLAction);\r
7902 begin\r
7903   Log( '->TKOLCustomControl.Setaction' );\r
7904   try\r
7905     if Faction <> Value then\r
7906     begin\r
7907       if Faction <> nil then\r
7908         Faction.UnLinkComponent(Self);\r
7909       Faction := Value;\r
7910       if Faction <> nil then\r
7911         Faction.LinkComponent(Self);\r
7912       Change;\r
7913     end;\r
7914     LogOK;\r
7915   finally\r
7916   Log( '<-TKOLCustomControl.Setaction' );\r
7917   end;\r
7918 end;\r
7919 \r
7920 procedure TKOLCustomControl.Notification(AComponent: TComponent; Operation: TOperation);\r
7921 begin\r
7922   //Log( '->TKOLCustomControl.Notification' );\r
7923   try\r
7924     //Rpt( 'Where from TKOLCustomControl.Notification called:' );\r
7925     //Rpt_Stack;\r
7926   inherited;\r
7927   if Operation = opRemove then\r
7928     if AComponent = Faction then\r
7929     begin\r
7930       //Rpt( 'Faction.UnLinkComponent(Self);' );\r
7931       Faction.UnLinkComponent(Self);\r
7932       Faction := nil;\r
7933       //Rpt( 'eeeeeeeeeeeeeeeeeeeeeeeee' );\r
7934     end;\r
7935   //LogOK;\r
7936   finally\r
7937   //Log( '<-TKOLCustomControl.Notification' );\r
7938   end;\r
7939 end;\r
7940 \r
7941 { TKOLApplet }\r
7942 \r
7943 procedure TKOLApplet.AssignEvents(SL: TStringList; const AName: String);\r
7944 begin\r
7945   asm\r
7946     jmp @@e_signature\r
7947     DB '#$signature$#', 0\r
7948     DB 'TKOLApplet.AssignEvents', 0\r
7949   @@e_signature:\r
7950   end;\r
7951   Log( '->TKOLApplet.AssignEvents' );\r
7952   TRY\r
7953 \r
7954   DoAssignEvents( SL, AName,\r
7955   [ 'OnMessage', 'OnDestroy', 'OnClose', 'OnQueryEndSession', 'OnMinimize', 'OnRestore' ],\r
7956   [ @OnMessage, @ OnDestroy, @ OnClose, @ OnQueryEndSession, @ OnMinimize, @ OnRestore  ] );\r
7957 \r
7958   LogOK;\r
7959   FINALLY\r
7960     Log( '<-TKOLApplet.AssignEvents' );\r
7961   END;\r
7962 end;\r
7963 \r
7964 function TKOLApplet.AutoCaption: Boolean;\r
7965 begin\r
7966   asm\r
7967     jmp @@e_signature\r
7968     DB '#$signature$#', 0\r
7969     DB 'TKOLApplet.AutoCaption', 0\r
7970   @@e_signature:\r
7971   end;\r
7972   Result := TRUE;\r
7973 end;\r
7974 \r
7975 function TKOLApplet.BestEventName: String;\r
7976 begin\r
7977   Result := 'OnMessage';\r
7978 end;\r
7979 \r
7980 procedure TKOLApplet.Change( Sender : TComponent );\r
7981 var S: String;\r
7982 begin\r
7983   asm\r
7984     jmp @@e_signature\r
7985     DB '#$signature$#', 0\r
7986     DB 'TKOLApplet.Change', 0\r
7987   @@e_signature:\r
7988   end;\r
7989   Log( '->TKOLApplet.Change' );\r
7990   TRY\r
7991 \r
7992   if fChangingNow or ( csLoading in ComponentState ) or (Name = '') then\r
7993   begin\r
7994     LogOK; Exit;\r
7995   end;\r
7996   //if Creating_DoNotGenerateCode then Exit;\r
7997   fChangingNow := TRUE;\r
7998   try\r
7999     FChanged := TRUE;\r
8000 \r
8001     if KOLProject <> nil then\r
8002     begin\r
8003       try\r
8004       S := KOLProject.SourcePath;\r
8005       except\r
8006         on E: Exception do\r
8007         begin\r
8008           ShowMessage( 'Can not obtain KOLProject.SourcePath, exception: ' +\r
8009                        E.Message );\r
8010           S := fSourcePath;\r
8011         end;\r
8012       end;\r
8013       fSourcePath := S;\r
8014       if (csLoading in ComponentState) then\r
8015       begin\r
8016         LogOK; Exit;\r
8017       end;\r
8018       if Sender <> nil then\r
8019       begin\r
8020         Rpt( Sender.Name + ': ' + Sender.ClassName + ' changed.' );\r
8021         //Rpt_Stack;\r
8022       end;\r
8023       //if (Sender <> nil) and (Sender.Name <> '') then\r
8024         KOLProject.Change;\r
8025     end\r
8026       else\r
8027     if (fSourcePath = '') or not DirectoryExists( fSourcePath ) or\r
8028        (ToolServices = nil) or not(Self is TKOLForm) then\r
8029     begin\r
8030       if FShowingWarnAbtMainForm then\r
8031       begin\r
8032         LogOK; Exit;\r
8033       end;\r
8034       if Abs( Integer( GetTickCount ) - FLastWarnTimeAbtMainForm ) > 3000 then\r
8035       begin\r
8036         FLastWarnTimeAbtMainForm := GetTickCount;\r
8037         if (csLoading in ComponentState) then\r
8038         begin\r
8039           LogOK; Exit;\r
8040         end;\r
8041         S := Name;\r
8042         if (Sender <> nil) and (Sender.Name <> '') then\r
8043           S := Sender.Name;\r
8044         if S = '' then\r
8045         begin\r
8046           LogOK; Exit;\r
8047         end;\r
8048         FShowingWarnAbtMainForm := True;\r
8049         ShowMessage( S + ' is changed, but changes can not ' +\r
8050                      'be applied because TKOLProject component is not found. ' +\r
8051                      'Be sure that your main form is opened in designer and ' +\r
8052                      'TKOLProject component present on it to provide automatic ' +\r
8053                      'or manual code generation for all changes made at design ' +\r
8054                      'time.' );\r
8055         FLastWarnTimeAbtMainForm := GetTickCount;\r
8056         FShowingWarnAbtMainForm := False;\r
8057       end;\r
8058     end\r
8059       else\r
8060     begin\r
8061       try\r
8062         if (csLoading in ComponentState) then\r
8063         begin\r
8064           LogOK; Exit;\r
8065         end;\r
8066         if Sender <> nil then\r
8067         begin\r
8068           Rpt( Sender.Name + ': ' + Sender.ClassName + ' changed.' );\r
8069         end;\r
8070         //S := ToolServices.GetCurrentFile;\r
8071         S := (Self as TKOLForm).formUnit; // by Speller\r
8072         //S := IncludeTrailingPathDelimiter( fSourcePath ) + ExtractFileName( S );\r
8073         S := IncludeTrailingPathDelimiter(fSourcePath) + S; // by Speller\r
8074         (Self as TKOLForm).GenerateUnit( S );\r
8075         //ShowMessage( S + ' is changed and is regenerated!' );\r
8076       except\r
8077         on E: Exception do\r
8078         begin\r
8079           ShowMessage( 'Can not handle Applet.Change, exception: ' + E.Message );\r
8080         end;\r
8081       end;\r
8082     end;\r
8083 \r
8084   finally\r
8085     fChangingNow := FALSE;\r
8086   end;\r
8087 \r
8088   LogOK;\r
8089   FINALLY\r
8090     Log( '<-TKOLApplet.Change' );\r
8091   END;\r
8092 end;\r
8093 \r
8094 procedure TKOLApplet.ChangeDPR;\r
8095 begin\r
8096   asm\r
8097     jmp @@e_signature\r
8098     DB '#$signature$#', 0\r
8099     DB 'TKOLApplet.ChangeDPR', 0\r
8100   @@e_signature:\r
8101   end;\r
8102   Log( '->TKOLApplet.ChangeDPR' );\r
8103   TRY\r
8104 \r
8105   BuildKOLProject;\r
8106 \r
8107   LogOK;\r
8108   FINALLY\r
8109     Log( '<-TKOLApplet.ChangeDPR' );\r
8110   END;\r
8111 end;\r
8112 \r
8113 constructor TKOLApplet.Create(AOwner: TComponent);\r
8114 //var WasCreating: Boolean;\r
8115 begin\r
8116   asm\r
8117     jmp @@e_signature\r
8118     DB '#$signature$#', 0\r
8119     DB 'TKOLApplet.Create', 0\r
8120   @@e_signature:\r
8121   end;\r
8122   Log( '->TKOLApplet.Create' );\r
8123   //WasCreating := Creating_DoNotGenerateCode;\r
8124   //Creating_DoNotGenerateCode := TRUE;\r
8125   TRY\r
8126 \r
8127   inherited;\r
8128   Visible := True;\r
8129   Enabled := True;\r
8130   if ClassName = 'TKOLApplet' then\r
8131   begin\r
8132     if KOLProject <> nil then\r
8133     begin\r
8134       if KOLProject.ProjectDest = '' then\r
8135         Caption := KOLProject.ProjectName\r
8136       else\r
8137         Caption := KOLProject.ProjectDest;\r
8138     end;\r
8139     if Applet <> nil then\r
8140     begin\r
8141       ShowMessage( 'You have already TKOLApplet component defined in your project. ' +\r
8142                    'It must be a single (and it is necessary in project only in ' +\r
8143                    'case, when the project contains several forms, or feature of ' +\r
8144                    'hiding application button on taskbar is desireable.'#13 +\r
8145                    'It is recommended to place TKOLApplet on main form of your ' +\r
8146                    'project, together with TKOLProject component.' );\r
8147     end\r
8148        else\r
8149       Applet := Self;\r
8150   end\r
8151      else\r
8152   begin\r
8153     if (Owner <> nil) and (Owner is TForm) then\r
8154     if AutoCaption then\r
8155       Caption := (Owner as TForm).Caption\r
8156     else\r
8157     begin\r
8158       if Caption <> '' then\r
8159         Caption := '';\r
8160       (Owner as TForm).Caption := '';\r
8161     end;\r
8162   end;\r
8163   FLastWarnTimeAbtMainForm := GetTickCount;\r
8164 \r
8165   LogOK;\r
8166   FINALLY\r
8167     Log( '<-TKOLApplet.Create' );\r
8168     //Creating_DoNotGenerateCode := WasCreating;\r
8169   END;\r
8170 end;\r
8171 \r
8172 destructor TKOLApplet.Destroy;\r
8173 begin\r
8174   asm\r
8175     jmp @@e_signature\r
8176     DB '#$signature$#', 0\r
8177     DB 'TKOLApplet.Destroy', 0\r
8178   @@e_signature:\r
8179   end;\r
8180   Log( '->TKOLApplet.Destroy' );\r
8181   TRY\r
8182 \r
8183   if Applet = Self then\r
8184     Applet := nil;\r
8185   inherited;\r
8186 \r
8187   LogOK;\r
8188   FINALLY\r
8189     Log( '<-TKOLApplet.Destroy' );\r
8190   END;\r
8191 end;\r
8192 \r
8193 procedure TKOLApplet.DoAssignEvents(SL: TStringList; const AName: String;\r
8194   EventNames: array of PChar; EventHandlers: array of Pointer);\r
8195 var I: Integer;\r
8196 begin\r
8197   asm\r
8198     jmp @@e_signature\r
8199     DB '#$signature$#', 0\r
8200     DB 'TKOLApplet.DoAssignEvents', 0\r
8201   @@e_signature:\r
8202   end;\r
8203   //Log( '->TKOLApplet.DoAssignEvents' );\r
8204   TRY\r
8205 \r
8206   for I := 0 to High( EventHandlers ) do\r
8207   begin\r
8208     if EventHandlers[ I ] <> nil then\r
8209     SL.Add( '      ' + AName + '.' + EventNames[ I ] + ' := Result.' +\r
8210             (Owner as TForm).MethodName( EventHandlers[ I ] ) + ';' );\r
8211   end;\r
8212 \r
8213   //LogOK;\r
8214   FINALLY\r
8215     //Log( '<-TKOLApplet.DoAssignEvents' );\r
8216   END;\r
8217 end;\r
8218 \r
8219 procedure TKOLApplet.GenerateRun(SL: TStringList; const AName: String);\r
8220 begin\r
8221   asm\r
8222     jmp @@e_signature\r
8223     DB '#$signature$#', 0\r
8224     DB 'TKOLApplet.GenerateRun', 0\r
8225   @@e_signature:\r
8226   end;\r
8227   Log( '->TKOLApplet.GenerateRun' );\r
8228   TRY\r
8229 \r
8230   if Tag <> 0 then\r
8231   begin\r
8232     if Tag < 0 then\r
8233       SL.Add( '  Applet.Tag := DWORD(' + Int2Str( Tag ) + ');' )\r
8234     else\r
8235       SL.Add( '  Applet.Tag := ' + Int2Str( Tag ) + ';' );\r
8236   end;\r
8237   if not(Self is TKOLForm) then\r
8238   begin\r
8239     if AllBtnReturnClick then\r
8240       SL.Add( '  Applet.AllBtnReturnClick;' );\r
8241     if Tabulate then\r
8242       SL.Add( '  Applet.Tabulate;' )\r
8243     else\r
8244     if TabulateEx then\r
8245       SL.Add( '  Applet.TabulateEx;' );\r
8246   end;\r
8247   SL.Add( '  Run( ' + AName + ' );' );\r
8248 \r
8249   LogOK;\r
8250   FINALLY\r
8251     Log( '<-TKOLApplet.GenerateRun' );\r
8252   END;\r
8253 end;\r
8254 \r
8255 procedure TKOLApplet.SetAllBtnReturnClick(const Value: Boolean);\r
8256 begin\r
8257   Log( '->TKOLApplet.SetAllBtnReturnClick' );\r
8258   TRY\r
8259   FAllBtnReturnClick := Value;\r
8260   Change( Self );\r
8261   LogOK;\r
8262   FINALLY\r
8263     Log( '<-TKOLApplet.SetAllBtnReturnClick' );\r
8264   END;\r
8265 end;\r
8266 \r
8267 \r
8268 procedure TKOLApplet.SetCaption(const Value: String);\r
8269 begin\r
8270   asm\r
8271     jmp @@e_signature\r
8272     DB '#$signature$#', 0\r
8273     DB 'TKOLApplet.SetCaption', 0\r
8274   @@e_signature:\r
8275   end;\r
8276   Log( '->TKOLApplet.SetCaption' );\r
8277   TRY\r
8278 \r
8279   fCaption := Value;\r
8280   Change( Self );\r
8281 \r
8282   LogOK;\r
8283   FINALLY\r
8284     Log( '<-TKOLApplet.SetCaption' );\r
8285   END;\r
8286 end;\r
8287 \r
8288 procedure TKOLApplet.SetEnabled(const Value: Boolean);\r
8289 begin\r
8290   asm\r
8291     jmp @@e_signature\r
8292     DB '#$signature$#', 0\r
8293     DB 'TKOLApplet.SetEnabled', 0\r
8294   @@e_signature:\r
8295   end;\r
8296   Log( '->TKOLApplet.SetEnabled' );\r
8297   TRY\r
8298 \r
8299   fEnabled := Value;\r
8300   Change( Self );\r
8301 \r
8302   LogOK;\r
8303   FINALLY\r
8304     Log( '<-TKOLApplet.SetEnabled' );\r
8305   END;\r
8306 end;\r
8307 \r
8308 procedure TKOLApplet.SetForceIcon16x16(const Value: Boolean);\r
8309 begin\r
8310   Log('->TKOLApplet.SetForceIcon16x16');\r
8311   TRY\r
8312 \r
8313   FForceIcon16x16 := Value;\r
8314   Change( Self );\r
8315 \r
8316   LogOK;\r
8317   FINALLY\r
8318     Log( '<-TKOLApplet.SetForceIcon16x16' );\r
8319   END;\r
8320 end;\r
8321 \r
8322 procedure TKOLApplet.SetIcon(const Value: String);\r
8323 begin\r
8324   asm\r
8325     jmp @@e_signature\r
8326     DB '#$signature$#', 0\r
8327     DB 'TKOLApplet.SetIcon', 0\r
8328   @@e_signature:\r
8329   end;\r
8330   Log( '->TKOLApplet.SetIcon' );\r
8331   TRY\r
8332 \r
8333   FIcon := Value;\r
8334   Change( Self );\r
8335 \r
8336   LogOK;\r
8337   FINALLY\r
8338     Log( '<-TKOLApplet.SetIcon' );\r
8339   END;\r
8340 end;\r
8341 \r
8342 procedure TKOLApplet.SetOnClose(const Value: TOnEventAccept);\r
8343 begin\r
8344   asm\r
8345     jmp @@e_signature\r
8346     DB '#$signature$#', 0\r
8347     DB 'TKOLApplet.SetOnClose', 0\r
8348   @@e_signature:\r
8349   end;\r
8350   Log( '->TKOLApplet.SetOnClose' );\r
8351   TRY\r
8352 \r
8353   FOnClose := Value;\r
8354   Change( Self );\r
8355 \r
8356   LogOK;\r
8357   FINALLY\r
8358     Log( '<-TKOLApplet.SetOnClose' );\r
8359   END;\r
8360 end;\r
8361 \r
8362 procedure TKOLApplet.SetOnDestroy(const Value: TOnEvent);\r
8363 begin\r
8364   asm\r
8365     jmp @@e_signature\r
8366     DB '#$signature$#', 0\r
8367     DB 'TKOLApplet.SetOnDestroy', 0\r
8368   @@e_signature:\r
8369   end;\r
8370   Log( '->TKOLApplet.SetOnDestroy' );\r
8371   TRY\r
8372 \r
8373   FOnDestroy := Value;\r
8374   Change( Self );\r
8375 \r
8376   LogOK;\r
8377   FINALLY\r
8378     Log( '<-TKOLApplet.SetOnDestroy' );\r
8379   END;\r
8380 end;\r
8381 \r
8382 procedure TKOLApplet.SetOnMessage(const Value: TOnMessage);\r
8383 begin\r
8384   asm\r
8385     jmp @@e_signature\r
8386     DB '#$signature$#', 0\r
8387     DB 'TKOLApplet.SetOnMessage', 0\r
8388   @@e_signature:\r
8389   end;\r
8390   Log( '->TKOLApplet.SetOnMessage' );\r
8391   TRY\r
8392 \r
8393   FOnMessage := Value;\r
8394   Change( Self );\r
8395 \r
8396   LogOK;\r
8397   FINALLY\r
8398     Log( '<-TKOLApplet.SetOnMessage' );\r
8399   END;\r
8400 end;\r
8401 \r
8402 procedure TKOLApplet.SetOnMinimize(const Value: TOnEvent);\r
8403 begin\r
8404   Log( '->TKOLApplet.SetOnMinimize' );\r
8405   TRY\r
8406 \r
8407   FOnMinimize := Value;\r
8408   Change( Self );\r
8409 \r
8410   LogOK;\r
8411   FINALLY\r
8412     Log( '<-TKOLApplet.SetOnMinimize' );\r
8413   END;\r
8414 end;\r
8415 \r
8416 procedure TKOLApplet.SetOnQueryEndSession(const Value: TOnEventAccept);\r
8417 begin\r
8418   Log( '->TKOLApplet.SetOnQueryEndSession' );\r
8419   try\r
8420   FOnQueryEndSession := Value;\r
8421   Change( Self );\r
8422   LogOK;\r
8423   finally\r
8424     Log( '<-TKOLApplet.SetOnQueryEndSession' );\r
8425   end;\r
8426 end;\r
8427 \r
8428 procedure TKOLApplet.SetOnRestore(const Value: TOnEvent);\r
8429 begin\r
8430   Log( '->TKOLApplet.SetOnRestore' );\r
8431   try\r
8432   FOnRestore := Value;\r
8433   Change( Self );\r
8434   LogOK;\r
8435   finally\r
8436   Log( '<-TKOLApplet.SetOnRestore' );\r
8437   end;\r
8438 end;\r
8439 \r
8440 procedure TKOLApplet.SetTabulate(const Value: Boolean);\r
8441 begin\r
8442   Log( '->TKOLApplet.SetTabulate' );\r
8443   try\r
8444   FTabulate := Value;\r
8445   if Value then\r
8446     FTabulateEx := False;\r
8447   Change( Self );\r
8448   LogOK;\r
8449   finally\r
8450   Log( '<-TKOLApplet.SetTabulate' );\r
8451   end;\r
8452 end;\r
8453 \r
8454 procedure TKOLApplet.SetTabulateEx(const Value: Boolean);\r
8455 begin\r
8456   Log( '->TKOLApplet.SetTabulateEx' );\r
8457   try\r
8458   FTabulateEx := Value;\r
8459   if Value then\r
8460     FTabulate := False;\r
8461   Change( Self );\r
8462   LogOK;\r
8463   finally\r
8464   Log( '<-TKOLApplet.SetTabulateEx' );\r
8465   end;\r
8466 end;\r
8467 \r
8468 procedure TKOLApplet.SetTag(const Value: Integer);\r
8469 begin\r
8470   Log( '->TKOLApplet.SetTag' );\r
8471   try\r
8472   FTag := Value;\r
8473   Change( Self );\r
8474   LogOK;\r
8475   finally\r
8476   Log( '<-TKOLApplet.SetTag' );\r
8477   end;\r
8478 end;\r
8479 \r
8480 procedure TKOLApplet.SetVisible(const Value: Boolean);\r
8481 begin\r
8482   asm\r
8483     jmp @@e_signature\r
8484     DB '#$signature$#', 0\r
8485     DB 'TKOLApplet.SetVisible', 0\r
8486   @@e_signature:\r
8487   end;\r
8488   Log( '->TKOLApplet.SetVisible' );\r
8489   try\r
8490   fVisible := Value;\r
8491   Change( Self );\r
8492   LogOK;\r
8493   finally\r
8494   Log( '<-TKOLApplet.SetVisible' );\r
8495   end;\r
8496 end;\r
8497 \r
8498 { TKOLForm }\r
8499 \r
8500 procedure TKOLForm.AssignEvents(SL: TStringList; const AName: String);\r
8501 begin\r
8502   asm\r
8503     jmp @@e_signature\r
8504     DB '#$signature$#', 0\r
8505     DB 'TKOLForm.AssignEvents', 0\r
8506   @@e_signature:\r
8507   end;\r
8508   Log( '->TKOLForm.AssignEvents' );\r
8509   try\r
8510   if not FLocked then\r
8511   begin\r
8512     if (Applet <> nil) and (Applet.Owner = Owner) then\r
8513       Applet.AssignEvents( SL, 'Applet' );\r
8514     //inherited;\r
8515     DoAssignEvents( SL, AName, [ 'OnMessage', 'OnClose', 'OnQueryEndSession' ],\r
8516                                [ @OnMessage, @ OnClose, @ OnQueryEndSession  ] );\r
8517     DoAssignEvents( SL, AName, [ 'OnMinimize', 'OnMaximize', 'OnRestore' ],\r
8518                                [ @ OnMinimize, @ OnMaximize, @ OnRestore  ] );\r
8519     DoAssignEvents( SL, AName,\r
8520     [ 'OnClick', 'OnMouseDblClk', 'OnMouseDown', 'OnMouseMove', 'OnMouseUp', 'OnMouseWheel', 'OnMouseEnter', 'OnMouseLeave' ],\r
8521     [ @OnClick,  @ OnMouseDblClk, @OnMouseDown,  @OnMouseMove,  @OnMouseUp,  @OnMouseWheel,  @OnMouseEnter,  @OnMouseLeave  ] );\r
8522     DoAssignEvents( SL, AName,\r
8523     [ 'OnEnter', 'OnLeave', 'OnKeyDown', 'OnKeyUp', 'OnChar', 'OnResize', 'OnMove', 'OnShow', 'OnHide' ],\r
8524     [ @OnEnter,  @OnLeave,  @OnKeyDown,  @OnKeyUp,  @OnChar,  @OnResize, @ OnMove, @ OnShow, @ OnHide ] );\r
8525     DoAssignEvents( SL, AName,\r
8526     [ 'OnPaint', 'OnEraseBkgnd', 'OnDropFiles' ],\r
8527     [ @ OnPaint, @ OnEraseBkgnd, @ OnDropFiles ] );\r
8528     // This event must be called at last! (and not assigned!) - so do this in SetupLast method.\r
8529     {DoAssignEvents( SL, AName,\r
8530     [ 'OnFormCreate' ],\r
8531     [ @ OnFormCreate ] );}\r
8532 \r
8533     DoAssignEvents( SL, AName,\r
8534     [ 'OnDestroy', 'OnHelp' ],\r
8535     [ @ OnDestroy, @ OnHelp ] );\r
8536     {if Assigned( OnDestroy ) then\r
8537       SL.Add( '      ' + AName + '.OnDestroy := Result.' +\r
8538               (Owner as TForm).MethodName( OnFormDestroy ) + ';' );}\r
8539   end;\r
8540   LogOK;\r
8541   finally\r
8542   Log( '<-TKOLForm.AssignEvents' );\r
8543   end;\r
8544 end;\r
8545 \r
8546 procedure TKOLForm.Change(Sender: TComponent);\r
8547 begin\r
8548   asm\r
8549     jmp @@e_signature\r
8550     DB '#$signature$#', 0\r
8551     DB 'TKOLForm.Change', 0\r
8552   @@e_signature:\r
8553   end;\r
8554   Log( '->TKOLForm.Change' );\r
8555   try\r
8556   //Success := False;\r
8557   if not FLocked and not ( csLoading in ComponentState ) then\r
8558   begin\r
8559     //if Creating_DoNotGenerateCode then Exit;\r
8560     if AllowRealign then\r
8561     if FRealigning = 0 then\r
8562     if FRealignTimer <> nil then\r
8563     begin\r
8564       FRealignTimer.Enabled := FALSE;\r
8565       FRealignTimer.Enabled := TRUE;\r
8566     end;\r
8567     if FChangeTimer <> nil then\r
8568     begin\r
8569       FChangeTimer.Enabled := FALSE;\r
8570       FChangeTimer.Enabled := TRUE;\r
8571     end\r
8572       else\r
8573     if not (csLoading in Sender.ComponentState) then\r
8574       DoChangeNow;\r
8575   end;\r
8576   LogOK;\r
8577   finally\r
8578   Log( '<-TKOLForm.Change' );\r
8579   end;\r
8580 end;\r
8581 \r
8582 constructor TKOLForm.Create(AOwner: TComponent);\r
8583 var I: Integer;\r
8584     C: TComponent;\r
8585 begin\r
8586   asm\r
8587     jmp @@e_signature\r
8588     DB '#$signature$#', 0\r
8589     DB 'TKOLForm.Create', 0\r
8590   @@e_signature:\r
8591   end;\r
8592   Log( '->TKOLForm.Create' );\r
8593   try\r
8594 \r
8595   Log( '?01 TKOLForm.Create' );\r
8596 \r
8597   if KOLProject <> nil then\r
8598   begin\r
8599     if KOLProject.ProjectDest = '' then\r
8600     begin\r
8601       raise Exception.Create( 'You forget to change projectDest property ' +\r
8602             'of TKOLProject component!' );\r
8603     end;\r
8604   end;\r
8605 \r
8606   Log( '?02 TKOLForm.Create' );\r
8607 \r
8608   inherited;\r
8609 \r
8610   Log( '?03 TKOLForm.Create' );\r
8611 \r
8612   //Creating_DoNotGenerateCode := TRUE;\r
8613   AllowRealign := TRUE;\r
8614 \r
8615   Log( '?03.A TKOLForm.Create' );\r
8616 \r
8617   FStatusText := TStringList.Create;\r
8618 \r
8619   Log( '?03.B TKOLForm.Create' );\r
8620 \r
8621   FStatusSizeGrip := TRUE;\r
8622 \r
8623   Log( '?03.C TKOLForm.Create' );\r
8624 \r
8625   FParentLikeFontControls := TList.Create;\r
8626 \r
8627   Log( '?03.D TKOLForm.Create' );\r
8628 \r
8629   FParentLikeColorControls := TList.Create;\r
8630   //fDefaultPos := True;\r
8631   //fDefaultSize := True;\r
8632 \r
8633   Log( '?03.E TKOLForm.Create' );\r
8634 \r
8635   fCanResize := True;\r
8636 \r
8637   Log( '?03.F TKOLForm.Create' );\r
8638 \r
8639   fVisible := True;\r
8640 \r
8641   Log( '?03.G TKOLForm.Create' );\r
8642 \r
8643   fAlphaBlend := 255;\r
8644 \r
8645   Log( '?03.H TKOLForm.Create' );\r
8646 \r
8647   fEnabled := True;\r
8648 \r
8649   Log( '?03.I TKOLForm.Create' );\r
8650 \r
8651   fMinimizeIcon := True;\r
8652 \r
8653   Log( '?03.J TKOLForm.Create' );\r
8654 \r
8655   fMaximizeIcon := True;\r
8656 \r
8657   Log( '?03.K TKOLForm.Create' );\r
8658 \r
8659   fCloseIcon := True;\r
8660 \r
8661   Log( '?03.L TKOLForm.Create' );\r
8662 \r
8663   FborderStyle := fbsSingle; {YS}\r
8664 \r
8665   Log( '?03.M TKOLForm.Create' );\r
8666 \r
8667   fHasBorder := True;\r
8668 \r
8669   Log( '?03.N TKOLForm.Create' );\r
8670 \r
8671   fHasCaption := True;\r
8672 \r
8673   Log( '?03.o TKOLForm.Create' );\r
8674 \r
8675   fCtl3D := True;\r
8676 \r
8677   Log( '?03.P TKOLForm.Create' );\r
8678 \r
8679   //AutoCreate := True;\r
8680   fMargin := 2;\r
8681 \r
8682   Log( '?03.Q TKOLForm.Create' );\r
8683 \r
8684   fBounds := TFormBounds.Create;\r
8685 \r
8686   Log( '?03.R TKOLForm.Create' );\r
8687 \r
8688   fBounds.Owner := Self;\r
8689   {fBounds.fL := (Owner as TForm).Left;\r
8690   fBounds.fT := (Owner as TForm).Top;\r
8691   fBounds.fW := (Owner as TForm).Width;\r
8692   fBounds.fH := (Owner as TForm).Height;}\r
8693   //fBrush := TBrush.Create;\r
8694 \r
8695   Log( '?04 TKOLForm.Create' );\r
8696   fFont := TKOLFont.Create( Self );\r
8697   fBrush := TKOLBrush.Create( Self );\r
8698 \r
8699   Log( '?05 TKOLForm.Create' );\r
8700 \r
8701   if AOwner <> nil then\r
8702   begin\r
8703     Log( '?06 TKOLForm.Create' );\r
8704     for I := 0 to AOwner.ComponentCount - 1 do\r
8705     begin\r
8706       C := AOwner.Components[ I ];\r
8707       if C = Self then Continue;\r
8708       if IsVCLControl( C ) then\r
8709       begin\r
8710         FLocked := TRUE;\r
8711         ShowMessage( 'The form ' + FormName + ' contains already VCL controls.'#13 +\r
8712         'The TKOLForm component is locked now and will not functioning.'#13 +\r
8713         'Just delete it and never drop onto forms, beloning to VCL projects.' );\r
8714         break;\r
8715       end;\r
8716     end;\r
8717     Log( '?07 TKOLForm.Create' );\r
8718     if not FLocked then\r
8719     for I := 0 to AOwner.ComponentCount - 1 do\r
8720     begin\r
8721       C := AOwner.Components[ I ];\r
8722       if C = Self then Continue;\r
8723       if C is TKOLForm then\r
8724       begin\r
8725         ShowMessage( 'The form ' + FormName + ' contains more then one instance of ' +\r
8726                      'TKOLForm component. '#13 +\r
8727                      'This will cause unpredictable results. It is recommended to ' +\r
8728                      'remove all ambigous instances of TKOLForm component before ' +\r
8729                      'You launch the project.' );\r
8730         break;\r
8731       end;\r
8732     end;\r
8733     Log( '?08 TKOLForm.Create' );\r
8734   end;\r
8735   if FormsList = nil then\r
8736     FormsList := TList.Create;\r
8737   Log( '?09 TKOLForm.Create' );\r
8738   FormsList.Add( Self );\r
8739   if not (csLoading in ComponentState) then\r
8740     if Caption = '' then\r
8741       Caption := FormName;\r
8742   Log( '?10 TKOLForm.Create' );\r
8743   (Owner as TForm).Scaled := FALSE;\r
8744   (Owner as TForm).HorzScrollBar.Visible := FALSE;\r
8745   (Owner as TForm).VertScrollBar.Visible := FALSE;\r
8746   Log( '?11 TKOLForm.Create' );\r
8747   FRealignTimer := TTimer.Create( Self );\r
8748   FRealignTimer.Interval := 50;\r
8749   FRealignTimer.OnTimer := RealignTimerTick;\r
8750   Log( '?12 TKOLForm.Create' );\r
8751   FChangeTimer := TTimer.Create( Self );\r
8752   FChangeTimer.OnTimer := ChangeTimerTick;\r
8753   FChangeTimer.Enabled := FALSE;\r
8754   FChangeTimer.Interval := 100;\r
8755   Log( '?13 TKOLForm.Create' );\r
8756   if not (csLoading in ComponentState) then\r
8757     FRealignTimer.Enabled := TRUE;\r
8758   Log( '?14 TKOLForm.Create' );\r
8759   LogOK;\r
8760   finally\r
8761   Log( '<-TKOLForm.Create' );\r
8762   //Creating_DoNotGenerateCode := FALSE;\r
8763   FChanged := FALSE;\r
8764   end;\r
8765 end;\r
8766 \r
8767 destructor TKOLForm.Destroy;\r
8768 var I: Integer;\r
8769 begin\r
8770   asm\r
8771     jmp @@e_signature\r
8772     DB '#$signature$#', 0\r
8773     DB 'TKOLForm.Destroy', 0\r
8774   @@e_signature:\r
8775   end;\r
8776   Log( '->TKOLForm.Destroy' );\r
8777   try\r
8778   bounds.EnableTimer( FALSE );\r
8779   AllowRealign := FALSE;\r
8780   fBounds.Free;\r
8781   if FormsList <> nil then\r
8782   begin\r
8783     I := FormsList.IndexOf( Self );\r
8784     if I >= 0 then\r
8785     begin\r
8786       FormsList.Delete( I );\r
8787       if FormsList.Count = 0 then\r
8788       begin\r
8789         FormsList.Free;\r
8790         FormsList := nil;\r
8791       end;\r
8792     end;\r
8793   end;\r
8794   fFont.Free;\r
8795   FParentLikeFontControls.Free;\r
8796   FParentLikeColorControls.Free;\r
8797   FStatusText.Free;\r
8798   ResStrings.Free;\r
8799   inherited;\r
8800   LogOK;\r
8801   finally\r
8802   Log( '<-TKOLForm.Destroy' );\r
8803   end;\r
8804 end;\r
8805 \r
8806 procedure SwapItems( Data: Pointer; const e1, e2: DWORD );\r
8807 var Tmp: Pointer;\r
8808     L: TList;\r
8809 begin\r
8810   asm\r
8811     jmp @@e_signature\r
8812     DB '#$signature$#', 0\r
8813     DB 'SwapItems', 0\r
8814   @@e_signature:\r
8815   end;\r
8816   L := Data;\r
8817   Tmp := L.Items[ e1 ];\r
8818   L.Items[ e1 ] := L.Items[ e2 ];\r
8819   L.Items[ e2 ] := Tmp;\r
8820   //Rpt( Int2Str( e1 ) + '<-->' + Int2Str( e2 ) );\r
8821 end;\r
8822 \r
8823 function CompareControls( Data: Pointer; const e1, e2: DWORD ): Integer;\r
8824 const Signs: array[ -1..1 ] of Char = ( '<', '=', '>' );\r
8825 var K1, K2: TKOLCustomControl;\r
8826     L: TList;\r
8827     function CompareInt( X, Y: Integer ): Integer;\r
8828     begin\r
8829       if X < Y then Result := -1\r
8830       else\r
8831       if X > Y then Result := 1\r
8832       else\r
8833       Result := 0;\r
8834     end;\r
8835 begin\r
8836   asm\r
8837     jmp @@e_signature\r
8838     DB '#$signature$#', 0\r
8839     DB 'CompareControls', 0\r
8840   @@e_signature:\r
8841   end;\r
8842   L := Data;\r
8843   K1 := L.Items[ e1 ];\r
8844   K2 := L.Items[ e2 ];\r
8845   Result := 0;\r
8846   if K1.Align = K2.Align then\r
8847   case K1.Align of\r
8848   caLeft: Result := CompareInt( K1.Left, K2.Left );\r
8849   caTop:  Result := CompareInt( K1.Top, K2.Top );\r
8850   caRight:Result := CompareInt( K2.Left, K1.Left );\r
8851   caBottom: Result := CompareInt( K2.Top, K1.Top );\r
8852   caClient: Result := CompareInt( K1.ControlIndex,\r
8853                                   K1.ControlIndex );\r
8854   end;\r
8855   if Result = 0 then\r
8856     Result := CompareInt( K1.TabOrder, K2.TabOrder );\r
8857   //Rpt( 'Compare ' + K1.Name + '.' + Int2Str( K1.TabOrder ) + ' ' + Signs[ Result ] + ' ' +\r
8858   //                  K2.Name + '.' + Int2Str( K2.TabOrder ) );\r
8859 end;\r
8860 \r
8861 const\r
8862 {$IFDEF VER90}\r
8863   {$DEFINE offDefined}\r
8864   offCreate = $24;\r
8865 {$ENDIF}\r
8866 {$IFDEF VER100}\r
8867   {$DEFINE offDefined}\r
8868   offCreate = $24;\r
8869 {$ENDIF}\r
8870 {$IFNDEF offDefined}\r
8871   offCreate = $2C;\r
8872 {$ENDIF}\r
8873 \r
8874 // Äàííàÿ ôóíêöèÿ êîíñòðóèðóåò è âîçâðàùàåò êîìïîíåíò òîãî æå êëàññà, ÷òî\r
8875 // è êîìïîíåíò, ïåðåäàííûé â êà÷åñòâå ïàðàìåòðà. Äëÿ êîíñòðóèðîâàíèÿ âûçûâàåòñÿ\r
8876 // âèðòóàëüíûé êîñòðóêòîð êîìïîíåíòà (ñìåùåíèå òî÷êè âõîäà â vmt çàâèñèò îò\r
8877 // âåðñèè Delphi).\r
8878 function ComponentLike( C: TComponent ): TComponent;\r
8879 asm\r
8880   xor ecx, ecx\r
8881   mov dl,1\r
8882   mov eax, [eax]\r
8883   call dword ptr [eax+offCreate]\r
8884 end;\r
8885 \r
8886 function Comma2Pt( const S: String ): String;\r
8887 begin\r
8888   asm\r
8889     jmp @@e_signature\r
8890     DB '#$signature$#', 0\r
8891     DB 'Comma2Pt', 0\r
8892   @@e_signature:\r
8893   end;\r
8894   Result := S;\r
8895   while pos( ',', Result ) > 0 do\r
8896     Result[ pos( ',', Result ) ] := '.';\r
8897 end;\r
8898 \r
8899 function Bool2Str( const S: String ): String;\r
8900 begin\r
8901   asm\r
8902     jmp @@e_signature\r
8903     DB '#$signature$#', 0\r
8904     DB 'Bool2Str', 0\r
8905   @@e_signature:\r
8906   end;\r
8907   if S = '0' then Result := 'FALSE'\r
8908   else            Result := 'TRUE';\r
8909 end;\r
8910 \r
8911 {$IFDEF _D2}\r
8912 function GetEnumProp(Instance: TObject; PropInfo: PPropInfo): string;\r
8913 begin\r
8914   asm\r
8915     jmp @@e_signature\r
8916     DB '#$signature$#', 0\r
8917     DB 'GetEnumProp', 0\r
8918   @@e_signature:\r
8919   end;\r
8920   Result := GetEnumName(PropInfo^.PropType, GetOrdProp(Instance, PropInfo));\r
8921 end;\r
8922 {$ENDIF}\r
8923 {$IFDEF _D3orD4}\r
8924 function GetEnumProp(Instance: TObject; PropInfo: PPropInfo): string;\r
8925 begin\r
8926   asm\r
8927     jmp @@e_signature\r
8928     DB '#$signature$#', 0\r
8929     DB 'GetEnumProp', 0\r
8930   @@e_signature:\r
8931   end;\r
8932   Result := GetEnumName(PropInfo^.PropType^, GetOrdProp(Instance, PropInfo));\r
8933 end;\r
8934 {$ENDIF}\r
8935 \r
8936 {$IFDEF _D2}\r
8937 type\r
8938   TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;\r
8939 \r
8940 function GetSetProp(Instance: TObject; PropInfo: PPropInfo;\r
8941   Brackets: Boolean): string;\r
8942 var\r
8943   S: TIntegerSet;\r
8944   TypeInfo: PTypeInfo;\r
8945   I: Integer;\r
8946 begin\r
8947   asm\r
8948     jmp @@e_signature\r
8949     DB '#$signature$#', 0\r
8950     DB 'GetSetProp', 0\r
8951   @@e_signature:\r
8952   end;\r
8953   Integer(S) := GetOrdProp(Instance, PropInfo);\r
8954   TypeInfo := GetTypeData(PropInfo.PropType).CompType;\r
8955   for I := 0 to SizeOf(Integer) * 8 - 1 do\r
8956     if I in S then\r
8957     begin\r
8958       if Result <> '' then\r
8959         Result := Result + ',';\r
8960       Result := Result + GetEnumName(TypeInfo, I);\r
8961     end;\r
8962   if Brackets then\r
8963     Result := '[' + Result + ']';\r
8964 end;\r
8965 {$ENDIF}\r
8966 {$IFDEF _D3orD4}\r
8967 type\r
8968   TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;\r
8969 \r
8970 function GetSetProp(Instance: TObject; PropInfo: PPropInfo;\r
8971   Brackets: Boolean): string;\r
8972 var\r
8973   S: TIntegerSet;\r
8974   TypeInfo: PTypeInfo;\r
8975   I: Integer;\r
8976 begin\r
8977   asm\r
8978     jmp @@e_signature\r
8979     DB '#$signature$#', 0\r
8980     DB 'GetSetProp', 0\r
8981   @@e_signature:\r
8982   end;\r
8983   Integer(S) := GetOrdProp(Instance, PropInfo);\r
8984   TypeInfo := GetTypeData(PropInfo.PropType^).CompType^;\r
8985   for I := 0 to SizeOf(Integer) * 8 - 1 do\r
8986     if I in S then\r
8987     begin\r
8988       if Result <> '' then\r
8989         Result := Result + ',';\r
8990       Result := Result + GetEnumName(TypeInfo, I);\r
8991     end;\r
8992   if Brackets then\r
8993     Result := '[' + Result + ']';\r
8994 end;\r
8995 {$ENDIF}\r
8996 \r
8997 // Äàííàÿ ôóíêöèÿ âîçâðàùàåò çíà÷åíèå ïóáëèêóåìîãî ñâîéñòâà êîìïîíåíòà â âèäå\r
8998 // ñòðîêè, êîòîðóþ ìîæíî âñòàâèòü â òåêñò ïðîãðàììû â ïðàâóþ ÷àñòü ïðèñâàèâàíèÿ\r
8999 // çíà÷åíèÿ ýòîìó ñâîéñòâó.\r
9000 function PropValueAsStr( C: TComponent; const PropName: String; PI: PPropInfo; SL: TStringList ): String;\r
9001 \r
9002   function StringConstant( const Propname, Value: String ): String;\r
9003   begin\r
9004     if C is TKOLForm then\r
9005       Result := (C as TKOLForm).StringConstant( Propname, Value )\r
9006     else if C is TKOLObj then\r
9007       Result := (C as TKOLObj).StringConstant( Propname, Value )\r
9008     else if C is TKOLCustomControl then\r
9009       Result := (C as TKOLCustomControl).StringConstant( Propname, Value )\r
9010     else\r
9011       Result := String2Pascal( Value );\r
9012   end;\r
9013 \r
9014 var PropValue: String;\r
9015     V: Variant;\r
9016     Method: TMethod;\r
9017     Ch: Char;\r
9018     Wc: WChar;\r
9019     S: String;\r
9020 begin\r
9021   asm\r
9022     jmp @@e_signature\r
9023     DB '#$signature$#', 0\r
9024     DB 'PropValueAsStr', 0\r
9025   @@e_signature:\r
9026   end;\r
9027   PropValue := '';\r
9028   Result := '';\r
9029   case PI.PropType^.Kind of\r
9030     tkVariant:\r
9031     begin\r
9032     try\r
9033       V := //GetPropValue( C, PropName, TRUE );\r
9034            GetVariantProp( C, PI );\r
9035       case VarType( V ) of\r
9036       varEmpty:     PropValue := 'UnAssigned';\r
9037       varNull:      PropValue := 'NULL';\r
9038       varSmallInt:  PropValue := 'VarAsType( ' + VarToStr( V ) + ', varSmallInt )';\r
9039       varInteger:   PropValue := IntToStr( V.AsInteger );\r
9040       varSingle:    PropValue := 'VarAsType( ' + Comma2Pt( VarToStr( V ) ) + ', varSingle )';\r
9041       varDouble:    PropValue := 'VarAsType( ' + Comma2Pt( VarToStr( V ) ) + ', varDouble )';\r
9042       varCurrency:  PropValue := 'VarAsType( ' + Comma2Pt( VarToStr( V ) ) + ', varCurrency )';\r
9043       varDate:      PropValue := 'VarAsType( ' + Comma2Pt( VarToStr( VarAsType( V, varDouble ) ) ) + ', varDate )';\r
9044       varByte:      PropValue := 'VarAsByte( ' + VarToStr( V ) + ' )';\r
9045       //varOLEStr:    PropValue := 'VarAsType( ' + String2Pascal( VarToStr( V ) ) + ', varOLEStr )';\r
9046       varOLEStr:    PropValue := 'VarAsType( ' + PCharStringConstant( C, Propname, VarToStr( V ) ) + ', varOLEStr )';\r
9047       //varString:    PropValue := String2Pascal( VarToStr( V ) );\r
9048       varString:    PropValue := StringConstant( Propname, VarToStr( V ) );\r
9049       varBoolean:   PropValue := Bool2Str( VarToStr( V ) );\r
9050       else\r
9051                    begin\r
9052        SL.Add( '    //----!!!---- Can not assign variant property ----!!!----' );\r
9053        Exit;\r
9054                    end;\r
9055       end;\r
9056     except\r
9057      SL.Add( '    //-----^----- Error getting variant value' )\r
9058     end;\r
9059     end;\r
9060     tkString, tkLString,\r
9061     {$IFDEF _D2} tkLWString {$ELSE} tkWString {$ENDIF}:\r
9062      try\r
9063        //PropValue := String2Pascal( GetStrProp( C,\r
9064        PropValue := StringConstant( Propname, GetStrProp( C,\r
9065                     {$IFDEF _D2orD3orD4} PI {$ELSE} PropName {$ENDIF} ) );\r
9066      except\r
9067        PropValue := '';\r
9068        SL.Add( '    //----^---- Cannot obtain string property ' + PropName +\r
9069                '. May be, it is write-only.' );\r
9070        raise;\r
9071      end;\r
9072     tkChar:\r
9073      begin\r
9074        Ch := Char( GetOrdProp( C, {$IFDEF _D2orD3orD4} PI {$ELSE} PropName {$ENDIF} ) );\r
9075        if Ch in [ ' '..#127 ] then\r
9076          PropValue := '''' + Ch + ''''\r
9077        else\r
9078          PropValue := '#' + IntToStr( Ord( Ch ) );\r
9079      end;\r
9080     tkWChar:\r
9081      begin\r
9082        Wc := WChar( GetOrdProp( C, {$IFDEF _D2orD3orD4} PI {$ELSE} PropName {$ENDIF} ) );\r
9083        if Wc in [ WChar(' ')..WChar(#127) ] then\r
9084          PropValue := '''' + Char( Wc ) + ''''\r
9085        else\r
9086          PropValue := 'WChar( ' + IntToStr( Ord( Wc ) ) + ' )';\r
9087      end;\r
9088     tkMethod:\r
9089     begin\r
9090       Method := GetMethodProp( C, {$IFDEF _D2orD3orD4} PI {$ELSE} PropName {$ENDIF} );\r
9091       if not Assigned( Method.Code ) then\r
9092         Exit;\r
9093       if C.Owner <> nil then\r
9094       if C.Owner is TForm then\r
9095         PropValue := 'Result.' + C.Owner.MethodName( Method.Code );\r
9096     end;\r
9097     tkInteger:     PropValue := Int2Str( GetOrdProp( C,\r
9098                                 {$IFDEF _D2orD3orD4} PI {$ELSE} PropName {$ENDIF} ) );\r
9099     tkEnumeration: PropValue := GetEnumProp( C, PI );\r
9100     tkFloat:       begin\r
9101                     S := FloatToStr( GetFloatProp( C, PI ) );\r
9102                     while pos( ',', S ) > 0 do\r
9103                       S[ pos( ',', S ) ] := '.';\r
9104                     PropValue := S;\r
9105                   end;\r
9106     tkSet:         PropValue := GetSetProp( C, PI, TRUE );\r
9107     {$IFNDEF _D2orD3}\r
9108     tkInt64:       PropValue := IntToStr( GetInt64Prop( C, PI ) );\r
9109     {$ENDIF}\r
9110     tkUnknown: begin\r
9111                 SL.Add( '    //-----?----- property type tkUnknown' );\r
9112                 Exit;\r
9113               end;\r
9114     else      Exit;\r
9115   end;\r
9116   Result := PropValue;\r
9117 end;\r
9118 \r
9119 // Êîíñòðóèðîâàíèå êîäà äëÿ êîìïîíåíòà, óíàñëåäîâàííîãî îò TComponent.\r
9120 // Âîîáùå-òî, â KOL-MCK-ïðîåêòàõ æåëàòåëüíî èñïîëüçîâàòü òîëüêî êîìïîíåíòû,\r
9121 // ñïåöèàëüíî ðàçðàáîòàííûå äëÿ MCK. Íî åñëè êîìïîíåíò ñëàáî ñâÿçàí ñ VCL è\r
9122 // íå òÿíåò íà ñåáÿ ìíîãî äîïîëíèòåëüíîãî êîäà, èñïîëüçîâàíèå åãî â ïðîåêòàõ\r
9123 // KOL âïîëíå âîçìîæíî. À èíîãäà æåëàòåëüíî.\r
9124 // Çäåñü ãåíåðèðóåòñÿ êîä, êîíñòðóèðóþùèé òàêîé êîìïîíåíò, ñîçäàííûé è\r
9125 // íàñòðîåííûé â deseign-time íà ôîðìå MCK-ïðîåêòà. Óñòàíàâëèâàþòñÿ âñå ïóáëè÷íûå\r
9126 // ñâîéñòâà, îòëè÷àþùèåñÿ ñâîèì çíà÷åíèåì îò òåõ, êîòîðûå íàçíà÷àþòñÿ ïî óìîë÷àíèþ\r
9127 // â êîíñòðóêòîðå îáúåêòà.\r
9128 procedure ConstructComponent( SL: TStringList; C: TComponent );\r
9129 var Props, PropsD: PPropList;\r
9130     NProps, NPropsD, I, J: Integer;\r
9131     PropName, PropValue, PropValueD: String;\r
9132     PI, DPI: PPropInfo;\r
9133     D: TComponent;\r
9134     WasError: Boolean;\r
9135 begin\r
9136   asm\r
9137     jmp @@e_signature\r
9138     DB '#$signature$#', 0\r
9139     DB 'ConstructComponent', 0\r
9140   @@e_signature:\r
9141   end;\r
9142   SL.Add( '    Result.' + C.Name + ' := ' + C.ClassName + '.Create( nil );' );\r
9143   if C is TOleControl then\r
9144     SL.Add( '    Result.' + C.Name +\r
9145             '.ParentWindow := Result.Form.GetWindowHandle;' );\r
9146   D := nil;\r
9147   GetMem( Props, Sizeof( TPropList ) );\r
9148   GetMem( PropsD, Sizeof( TPropList ) );\r
9149   try\r
9150   try\r
9151     NProps := GetPropList( C.ClassInfo, tkAny, Props );\r
9152     SL.Add( '    //-- found ' + Int2Str( NProps ) + ' published props' );\r
9153     if NProps > 0 then\r
9154     BEGIN\r
9155       D := ComponentLike( C );\r
9156       NPropsD :=  GetPropList( C.ClassInfo, tkAny, PropsD );\r
9157       for I := 0 to NProps-1 do\r
9158       begin\r
9159          PI := Props[ I ];\r
9160          PropName := PI.Name;\r
9161          DPI := nil;\r
9162          for J := 0 to NPropsD-1 do\r
9163          begin\r
9164            DPI := PropsD[ J ];\r
9165            if PropName = DPI.Name then break;\r
9166            DPI := nil;\r
9167          end;\r
9168 \r
9169          SL.Add( '    // ' + IntToStr( I ) + ': ' + PropName );\r
9170          //if not IsStoredProp( C, PropName ) then continue;\r
9171          PropValueD := '';\r
9172          WasError := FALSE;\r
9173          try\r
9174            if DPI <> nil then\r
9175            if DPI.PropType^.Kind = PI.PropType^.Kind then\r
9176              PropValueD := PropValueAsStr( D, PropName, DPI, SL );\r
9177            PropValue := PropValueAsStr( C, PropName, PI, SL );\r
9178            if (DPI = nil) or (PropValue <> PropValueD) then\r
9179            SL.Add( '    Result.' + C.Name + '.' + PropName + ' := ' +\r
9180                    PropValue + ';' );\r
9181          except\r
9182            WasError := TRUE;\r
9183          end;\r
9184          if WasError then\r
9185          try\r
9186            if DPI <> nil then\r
9187            if DPI.PropType^.Kind = PI.PropType^.Kind then\r
9188            begin\r
9189              PropValueD := PropValueAsStr( D, PropName, DPI, SL );\r
9190              SL.Add( '    //Default: ' + PropName + '=' + PropValueD );\r
9191            end;\r
9192            PropValue := PropValueAsStr( C, PropName, PI, SL );\r
9193            SL.Add(   '    //Actual : ' + PropName + '=' + PropValue );\r
9194            if (DPI = nil) or (PropValue <> PropValueD) then\r
9195            SL.Add( '    Result.' + C.Name + '.' + PropName + ' := ' +\r
9196                    PropValue + ';' );\r
9197          except\r
9198            SL.Add( '    //-----^------Exception while getting propery ' +\r
9199                    PropName + ' of ' + C.Name );\r
9200          end;\r
9201       end;\r
9202     END;\r
9203   finally\r
9204     FreeMem( Props );\r
9205     D.Free;\r
9206   end;\r
9207   except\r
9208     SL.Add( '    //-----^------Exception while getting properties of ' + C.Name );\r
9209   end;\r
9210 end;\r
9211 \r
9212 \r
9213 procedure TKOLForm.GenerateChildren( SL: TStringList; OfParent: TComponent; const OfParentName: String; const Prefix: String;\r
9214           var Updated: Boolean );\r
9215 var I: Integer;\r
9216     L: TList;\r
9217     S: String;\r
9218     KC: TKOLCustomControl;\r
9219 begin\r
9220   asm\r
9221     jmp @@e_signature\r
9222     DB '#$signature$#', 0\r
9223     DB 'TKOLForm.GenerateChildren', 0\r
9224   @@e_signature:\r
9225   end;\r
9226   Log( '->TKOLForm.GenerateChildren' );\r
9227   try\r
9228   L := TList.Create;\r
9229   try\r
9230     for I := 0 to Owner.ComponentCount - 1 do\r
9231     begin\r
9232       if Owner.Components[ I ] is TKOLCustomControl then\r
9233       if (Owner.Components[ I ] as TKOLCustomControl).ParentKOLControl = OfParent then\r
9234       begin\r
9235         //Rpt( 'Look for ' + OfParent.Name + ': ' + Owner.Components[ I ].Name );\r
9236         //Rpt( '.ParentKOLControl = ' + (Owner.Components[ I ] as TKOLCustomControl).ParentKOLControl.Name );\r
9237         KC := Owner.Components[ I ] as TKOLCustomControl;\r
9238         L.Add( KC );\r
9239       end;\r
9240     end;\r
9241     SortData( L, L.Count, @CompareControls, @SwapItems );\r
9242     for I := 0 to L.Count - 1 do\r
9243     begin\r
9244       KC := L.Items[ I ];\r
9245       KC.fUpdated := FALSE;\r
9246       SL.Add( '    // ' + KC.RefName + '.TabOrder = ' + Int2Str( KC.TabOrder ) );\r
9247       KC.SetupFirst( SL, KC.RefName, OfParentName, Prefix );\r
9248       GenerateAdd2AutoFree( SL, KC.RefName, TRUE, '', KC );\r
9249       S := KC.RefName;\r
9250       GenerateChildren( SL, KC, S, Prefix + '  ', Updated );\r
9251       if KC.fUpdated then\r
9252         Updated := TRUE;\r
9253     end;\r
9254   finally\r
9255     L.Free;\r
9256   end;\r
9257   LogOK;\r
9258   finally\r
9259   Log( '<-TKOLForm.GenerateChildren' );\r
9260   end;\r
9261 end;\r
9262 \r
9263 function TKOLForm.AppletOnForm: Boolean;\r
9264 var I: Integer;\r
9265     F: TForm;\r
9266 begin\r
9267   asm\r
9268     jmp @@e_signature\r
9269     DB '#$signature$#', 0\r
9270     DB 'TKOLForm.AppletOnForm', 0\r
9271   @@e_signature:\r
9272   end;\r
9273   Log( '->TKOLForm.AppletOnForm' );\r
9274   try\r
9275   Result := FALSE;\r
9276   if Owner <> nil then\r
9277   begin\r
9278     F := Owner as TForm;\r
9279     for I := 0 to F.ComponentCount - 1 do\r
9280       if F.Components[ I ].ClassNameIs( 'TKOLApplet' ) then\r
9281       begin\r
9282         Result := TRUE;\r
9283         break;\r
9284       end;\r
9285   end;\r
9286   LogOK;\r
9287   finally\r
9288   Log( '<-TKOLForm.AppletOnForm' );\r
9289   end;\r
9290 end;\r
9291 \r
9292 function CompareComponentOrder( const AList : Pointer; const e1, e2 : DWORD ) : Integer;\r
9293 var OC: TList;\r
9294     C1, C2: TComponent;\r
9295     S: String;\r
9296     B: Boolean;\r
9297     K1, K2: TKOLCustomControl;\r
9298 begin\r
9299   asm\r
9300     jmp @@e_signature\r
9301     DB '#$signature$#', 0\r
9302     DB 'CompareComponentOrder', 0\r
9303   @@e_signature:\r
9304   end;\r
9305   OC := AList;\r
9306   C1 := OC[ e1 ];\r
9307   C2 := OC[ e2 ];\r
9308   Result := 0;\r
9309   if (C1 is TKOLObj) and (C2 is TKOLObj) then\r
9310   begin\r
9311     if (C1 as TKOLObj).CreationPriority <> (C2 as TKOLObj).CreationPriority then\r
9312       Result := CmpInts( (C1 as TKOLObj).CreationPriority,\r
9313                          (C2 as TKOLObj).CreationPriority );\r
9314   end;\r
9315   if Result = 0 then\r
9316   if ((C1 is TKOLObj) or (C1 is TKOLCustomControl)) and\r
9317      ((C2 is TKOLObj) or (C2 is TKOLCustomControl)) then\r
9318   begin\r
9319     if C2 is TKOLObj then\r
9320       S := (C2 as TKOLObj).TypeName\r
9321     else\r
9322       S := (C2 as TKOLCustomControl).TypeName;\r
9323     if C1 is TKOLObj then\r
9324       B := (C1 as TKOLObj).CompareFirst( S, C2.Name )\r
9325     else\r
9326       B := (C1 as TKOLCustomControl).CompareFirst( S, C2.Name );\r
9327     if B then Result := 1;\r
9328   end;\r
9329   if Result = 0 then\r
9330   begin\r
9331     if (C1 is TKOLCustomControl) and (C2 is TKOLCustomControl) then\r
9332     begin\r
9333       K1 := C1 as TKOLCustomControl;\r
9334       K2 := C2 as TKOLCustomControl;\r
9335       Result := CmpInts( K1.TabOrder, K2.TabOrder );\r
9336       if Result = 0 then\r
9337       begin\r
9338         if (K1.Align in [caLeft, caRight]) and (K2.Align in [caLeft, caRight]) then\r
9339           Result := CmpInts( K1.Left, K2.Left )\r
9340         else\r
9341         if (K1.Align in [caTop, caBottom]) and (K2.Align in [caTop, caBottom]) then\r
9342           Result := CmpInts( K1.Top, K2.Top );\r
9343       end;\r
9344     end\r
9345       else\r
9346     Result := CmpInts( e1, e2 );\r
9347   end;\r
9348 end;\r
9349 \r
9350 procedure SwapComponents( const AList : Pointer; const e1, e2 : DWORD );\r
9351 var OC: TList;\r
9352     Tmp: Pointer;\r
9353 begin\r
9354   asm\r
9355     jmp @@e_signature\r
9356     DB '#$signature$#', 0\r
9357     DB 'SwapComponents', 0\r
9358   @@e_signature:\r
9359   end;\r
9360   OC := AList;\r
9361   Tmp := OC[ e1 ];\r
9362   OC[ e1 ] := OC[ e2 ];\r
9363   OC[ e2 ] := Tmp;\r
9364 end;\r
9365 \r
9366   // Â ðåçóëüòèðóþùåì ïðîåêòå:\r
9367   // Òèï TMyForm - ñîäåðæèò îáðàáîò÷èêè ñîáûòèé ôîðìû è åå îáúåêòîâ,\r
9368   // à òàê æå îïèñàíèÿ äî÷åðíèõ âèçóàëüíûõ è íåâèçóàëüíûõ îáúåêòîâ.\r
9369   // (MyForm çàìåíÿåòñÿ íàñòîÿùèì èìåíåì ôîðìû). Ôàêòè÷åñêè íå ÿâëÿåòñÿ\r
9370   // ôîðìîé, êàê ýòî ïðîèñõîäèò â VCL, ãäå êàæäàÿ âèçóàëüíî ðàçðàáàòûâàåìàÿ\r
9371   // ôîðìà ñòàíîâèòñÿ íàñëåäíèêîì îò TForm. Íàì ïðîñòî óäîáíî çäåñü\r
9372   // ñäåëàòü òàê, ïîòîìó, ÷òî ïîÿâëÿåòñÿ âîçìîæíîñòü âïèñûâàòü êîä\r
9373   // ïðÿìî â çåðêàëüíûé VCL-ïðîåêò, è ïðè ýòîì îáúåêòû ôîðìû èìåþò òó æå\r
9374   // îáëàñòü âèäèìîñòè â ðåçóëüòèðóþùåì KOL-ïðîåêòå. Áîëåå òîãî, íåò íóæäû\r
9375   // àíàëèçèðîâàòü ñèíòàêñèñ Ïàñêàëÿ - äîñòàòî÷íî ñêîïèðîâàòü èñõîäíûé\r
9376   // ìîäóëü íà÷èíàÿ ñî ñëîâà 'implementation' è äîáàâèòü ê íåìó òîëüêî\r
9377   // ïàðó ãåíåðèðóåìûõ ïðîöåäóð.\r
9378   //\r
9379   // Êàê ìèíèìóì, â íåì ñîäåðæèòñÿ óêàçàòåëü íà ñàìó ôîðìó, èìåþùèé\r
9380   // èìÿ Form. Çäåñü ìû âûñòàâèì òðåáîâàíèå: òàê êàê â KOL ïåðåìåííàÿ\r
9381   // Self áóäåò íåäîñòóïíà (è áóäåò îçíà÷àòü óêàçàòåëü âîò ýòîãî ïñåâäî-\r
9382   // îáúåêòà, êîòîðûé ñåé÷àñ îïèñûâàåòñÿ), òî ïðè íàïèñàíèè êîäà\r
9383   // (â îáðàáîò÷èêàõ ñîáûòèé) òðåáóåòñÿ ÿâíî óêàçûâàòü ñëîâî Form.\r
9384   // Ïðè òàêîì ïîäõîäå êîä ñìîæåò áûòü ñêîìïèëèðîâàí â îáåèõ ñðåäàõ\r
9385   // (õîòÿ ýòî è áóäåò ðàçíûé êîä).\r
9386 function TKOLForm.GenerateINC(const Path: String; var Updated: Boolean): Boolean;\r
9387 var SL: TStringList;\r
9388     I: Integer;\r
9389 var\r
9390     MainMenuPresent: boolean;\r
9391     PopupMenuPresent: boolean;\r
9392     KO: TKOLObj;\r
9393     KC: TKOLCustomControl;\r
9394     NeedOleInit: Boolean;\r
9395 \r
9396     //-- by Alexander Shakhaylo\r
9397     OC: TList;\r
9398     //--------------------------\r
9399 begin\r
9400   asm\r
9401     jmp @@e_signature\r
9402     DB '#$signature$#', 0\r
9403     DB 'TKOLForm.GenerateINC', 0\r
9404   @@e_signature:\r
9405   end;\r
9406   Log( '->TKOLForm.GenerateINC' );\r
9407   try\r
9408   Result := FALSE;\r
9409   if csLoading in ComponentState then\r
9410   begin\r
9411     LogOK; Exit;\r
9412   end;\r
9413   // íå áóäåì ïûòàòüñÿ ãåíåðèðîâàòü êîä, ïîêà ôîðìà íå çàãðóçèëàñü â äèçàéíåð!\r
9414    \r
9415   Rpt( 'Generating INC for ' + Path ); //Rpt_Stack;\r
9416 \r
9417   ResStrings.Free;\r
9418   ResStrings := nil;\r
9419 \r
9420   //-- by Alexander Shakhaylo\r
9421   oc := TList.Create;\r
9422   TRY\r
9423 \r
9424     for i := 0 to Owner.ComponentCount - 1 do\r
9425        oc.Add(Owner.Components[ i ]);\r
9426 \r
9427     SortData( oc, oc.Count, @CompareComponentOrder, @SwapComponents );\r
9428 \r
9429   //--------------------------\r
9430 \r
9431     SL := TStringList.Create;\r
9432     Result := False;\r
9433     if FLocked then\r
9434     begin\r
9435       LogOK; Exit;\r
9436     end;\r
9437 \r
9438     try\r
9439 \r
9440     // Step 3. Generate <FormUnit_1.inc, containing constructor of\r
9441     // form holder object.\r
9442     //\r
9443     SL.Add( Signature );\r
9444 \r
9445     // Generating constants for menu items, toolbar buttons, list view columns, etc.\r
9446     for I := 0 to oc.Count - 1 do\r
9447     begin\r
9448       if TComponent( oc[ I ] ) is TKOLObj then\r
9449         TKOLObj( oc[ I ] ).DoGenerateConstants( SL )\r
9450       else\r
9451       if TComponent( oc[ I ] ) is TKOLCustomControl then\r
9452         TKOLToolbar( oc[ I ] ).DoGenerateConstants( SL );\r
9453     end;\r
9454 \r
9455     // Ïðîöåäóðà ñîçäàíèÿ îáúåêòà, ñîïîñòàâëåííîãî ôîðìå. Âûçûâàåòñÿ\r
9456     // àâòîìàòè÷åñêè äëÿ àâòîìàòè÷åñêè ñîçäàâàåìûõ ôîðì (è äëÿ ãëàâíîé\r
9457     // ôîðìû â ïåðâóþ î÷åðåäü):\r
9458     SL.Add( '' );\r
9459     SL.Add( 'procedure New' + FormName + '( var Result: P' + FormName +\r
9460             '; AParent: PControl );' );\r
9461     SL.Add( 'begin' );\r
9462     SL.Add( '' );\r
9463     SL.Add( '  {$IFDEF KOLCLASSES}' );\r
9464     SL.Add( '  Result := P' + FormName + '.Create;' );\r
9465     SL.Add( '  {$ELSE OBJECTS}' );\r
9466     SL.Add( '  New( Result, Create );' );\r
9467     SL.Add( '  {$ENDIF KOL CLASSES/OBJECTS}' );\r
9468     // "Äåðæàòåëü ôîðìû" ãîòîâ. Òåïåðü êîíñòðóèðóåì ñàìó ôîðìó.\r
9469     GenerateCreateForm( SL );\r
9470     Log( 'after GenerateCreateForm, next: GenerateAdd2AutoFree' );\r
9471     GenerateAdd2AutoFree( SL, 'Result', FALSE, '', nil );\r
9472     Log( 'after GenerateAdd2AutoFree, next: SetupFirst' );\r
9473     //SL.Add( '  Result.Form.Add2AutoFree( Result );' );\r
9474 \r
9475     SetupFirst( SL, Result_Form, 'AParent', '    ' );\r
9476 \r
9477     //////////////////////////////////////////////////////\r
9478     //  SUPPORT ACTIVE-X CONTROLS\r
9479     {}\r
9480     {}NeedOleInit := FALSE;\r
9481     {}for I := 0 to oc.Count-1 do\r
9482     {}begin\r
9483     {}  if TComponent( oc[ I ] ) is TOleControl then\r
9484     {}  begin\r
9485     {}    NeedOleInit := TRUE;\r
9486     {}    break;\r
9487     {}  end;\r
9488     {}end;\r
9489     {}\r
9490     {}if NeedOleInit then\r
9491     {}begin\r
9492     {}  SL.Add( '  OleInit;' );\r
9493     {}  SL.Add( '  Result.Add2AutoFreeEx( TObjectMethod( ' +\r
9494     {}            'MakeMethod( nil, @OleUninit ) ) );' );\r
9495     {}end;\r
9496     {}\r
9497     /////////////////////////////////////////////////////////\r
9498 \r
9499 \r
9500     // Êîíñòðóèðóåì êîìïîíåíòû VCL. Íåõîðîøî èñïîëüçîâàòü â ïðîåêòà êîìïîíåíòû\r
9501     // çàâÿçàííûå íà VCL, íî íå âñå îíè ñèëüíî çàâÿçàíû ñ ñàìèì VCL.\r
9502     for I := 0 to oc.Count-1 do\r
9503     begin\r
9504       if not( (TComponent( oc[ I ] ) is TKOLObj) or\r
9505               (TComponent( oc[ I ] ) is TControl) or\r
9506               (TComponent( oc[ I ] ) is TKOLApplet or\r
9507               (TComponent( oc[ I ] ) is TKOLProject)))\r
9508          or (TComponent( oc[ I ] ) is TOlecontrol) then\r
9509       if TComponent( oc[ I ] ) is TComponent then // àé-ÿ-ÿé!\r
9510       begin\r
9511         SL.Add( '' );\r
9512         ConstructComponent( SL, oc[ I ] );\r
9513         GenerateAdd2AutoFree( SL, 'Result.' + TComponent( oc[ I ] ).Name + '.Free',\r
9514           FALSE, 'Add2AutoFreeEx', nil );\r
9515       end;\r
9516     end;\r
9517 \r
9518     // Çäåñü âûïîëíÿåòñÿ êîíñòðóèðîâàíèå äî÷åðíèõ îáúåêòîâ - â ïåðâóþ î÷åðåäü òåõ,\r
9519     // êîòîðûå íå èìåþò ôîðìàëüíîãî ðîäèòåëÿ, ò.å. íàñëåäíèêîâ KOL.TObj (â çåðêàëå\r
9520     // - TKOLObj). Ñíà÷àëà êîíñòðóèðóåòñÿ ãëàâíîå ìåíþ, åñëè îíî åñòü íà ôîðìå.\r
9521     // Åñëè ãëàâíîå ìåíþ îòñóòñòâóåò, íî åñòü õîòÿ áû îäíî êîíòåêñòíîå ìåíþ,\r
9522     // ãåíåðèðóåòñÿ ïóñòîé îáúåêò ãëàâíîé ôîðìû - ñ òåì, ÷òîáû ïðî÷èå ìåíþ àâòîìàòîì\r
9523     // áûëè êîíòåêñòíûìè.\r
9524     MainMenuPresent := False;\r
9525     PopupMenuPresent := False;\r
9526     for I := 0 to oc.Count - 1 do\r
9527     begin\r
9528       if TComponent( oc[ I ] ) is TKOLMainMenu then\r
9529       begin\r
9530         MainMenuPresent := True;\r
9531         KO := TComponent( oc[ I ] ) as TKOLObj;\r
9532         SL.Add( '' );\r
9533         KO.SetupFirst( SL, 'Result.' + KO.Name, Result_Form, '    ' );\r
9534         GenerateAdd2AutoFree( SL, 'Result.' + KO.Name, TRUE, '', KO );\r
9535         KO.AssignEvents( SL, 'Result.' + KO.Name );\r
9536       end\r
9537         else\r
9538       if TComponent( oc[ I ] ) is TKOLPopupMenu then\r
9539         PopupMenuPresent := True;\r
9540     end;\r
9541 \r
9542     if PopupMenuPresent and not MainMenuPresent and\r
9543        ClassNameIs( 'TKOLForm' ) then\r
9544     begin\r
9545       SL.Add( '    NewMenu( ' + Result_Form + ', 0, [ '''' ], nil );' );\r
9546     end;\r
9547 \r
9548     for I := 0 to oc.Count - 1 do\r
9549     begin\r
9550       if TComponent( oc[ I ] ) is TKOLMainMenu then continue;\r
9551       if TComponent( oc[ I ] ) is TKOLObj then\r
9552       begin\r
9553         KO := TComponent( oc[ I ] ) as TKOLObj;\r
9554         KO.fUpdated := FALSE;\r
9555         SL.Add( '' );\r
9556         KO.SetupFirst( SL, 'Result.' + KO.Name, Result_Form, '    ' );\r
9557         GenerateAdd2AutoFree( SL, 'Result.' + KO.Name, FALSE, '', KO );\r
9558         //SL.Add( '    Result.Form.Add2AutoFree( Result.' + KO.Name + ' );'  );\r
9559         KO.AssignEvents( SL, 'Result.' + KO.Name );\r
9560         if KO.fUpdated then\r
9561           Updated := TRUE;\r
9562       end;\r
9563     end;\r
9564 \r
9565     // Äàëåå âûïîëíÿåòñÿ ðåêóðñèâíûé îáõîä ïî äåðåâó äî÷åðíèõ êîíòðîëîâ è\r
9566     // ãåíåðàöèÿ êîäà äëÿ íèõ:\r
9567     GenerateChildren( SL, Self, Result_Form, '    ', Updated );\r
9568 \r
9569     // Ïî çàâåðøåíèè ïåðâîíà÷àëüíîé ãåíåðàöèè âûïîëíÿåòñÿ åùå îäèí ïðîñìîòð\r
9570     // âñåõ êîíòðîëîâ è îáúåêòîâ ôîðìû, è äëÿ íèõ âûïîëíÿåòñÿ SetupLast -\r
9571     // ãåíåðàöèÿ êîäà, êîòîðûé äîëæåí âûïîëíèòüñÿ íà ïîñëåäíåì ýòàïå\r
9572     // èíèöèàëèçàöèè (íàïðèìåð, ñâîéñòâî CanResize ïðèñâàèâàåòñÿ False òîëüêî\r
9573     // íà ýòîì ýòàïå. Åñëè ýòî ñäåëàòü ðàíüøå, òî ìîãóò âîçíèêíóòü ïðîáëåìû\r
9574     // ñ èçìåíåíèåì ðàçìåðîâ îêíà â ïðîöåññå íàñòðîéêè ôîðìû).\r
9575     for I := 0 to oc.Count - 1 do\r
9576     begin\r
9577       if TComponent( oc[ I ] ) is TKOLCustomControl then\r
9578       begin\r
9579         KC := TComponent( oc[ I ] ) as TKOLCustomControl;\r
9580         KC.SetupLast( SL, KC.RefName, Result_Form, '    ' );\r
9581       end\r
9582          else\r
9583       if TComponent( oc[ I ] ) is TKOLObj then\r
9584       begin\r
9585         KO := TComponent( oc[ I ] ) as TKOLObj;\r
9586         KO.SetupLast( SL, 'Result.' + KO.Name, Result_Form, '    ' );\r
9587       end;\r
9588     end;\r
9589     // Íå çàáóäåì òàê æå âûçâàòü SetupLast äëÿ ñàìîé ôîðìû (ìîæíî áûëî áû\r
9590     // âñóíóòü êîä ïðÿìî ñþäà, íî òàê áóäåò ëåã÷å ïîòîì ñîïðîâîæäàòü):\r
9591     SetupLast( SL, Result_Form, 'AParent', '    ' );\r
9592 \r
9593     SL.Add( '' );\r
9594     SL.Add( 'end;' );\r
9595     SL.Add( '' );\r
9596 \r
9597     {P := True;\r
9598     if KOLProject <> nil then\r
9599       P := KOLProject.ProtectFiles;}\r
9600 \r
9601     if ResStrings <> nil then\r
9602     begin\r
9603       for I := ResStrings.Count-1 downto 0 do\r
9604         SL.Insert( 1, ResStrings[ I ] );\r
9605     end;\r
9606 \r
9607     SaveStrings( SL, Path + '_1.inc', Updated );\r
9608     Result := True;\r
9609 \r
9610     except\r
9611       //++++++++++ { Maxim Pushkar } +++++++++\r
9612       on E: Exception do\r
9613       begin\r
9614         Rpt( 'EXCEPTION FOUND 9289: ' + E.Message);\r
9615         Rpt_Stack;\r
9616       end;\r
9617       //++++++++++++++++++++++++++++++++++++++\r
9618     end;\r
9619 \r
9620     SL.Free;\r
9621 \r
9622   FINALLY\r
9623     oc.Free;\r
9624   END;\r
9625 \r
9626   Sleep( 0 ); //**** THIS IS MUST ****\r
9627   { added in v0.84 to fix TKOLFrame, when TKOLCustomControl descendant component\r
9628     is dropped on TKOLFrame. }\r
9629   LogOK;\r
9630   finally\r
9631   Log( '<-TKOLForm.GenerateINC' );\r
9632   end;\r
9633 end;\r
9634 \r
9635 function TrimAll( const S: String ): String;\r
9636 var I: Integer;\r
9637 begin\r
9638   asm\r
9639     jmp @@e_signature\r
9640     DB '#$signature$#', 0\r
9641     DB 'TrimAll', 0\r
9642   @@e_signature:\r
9643   end;\r
9644   Result := S;\r
9645   for I := Length( Result ) downto 1 do\r
9646     if Result[ I ] <= ' ' then\r
9647       Delete( Result, I, 1 );\r
9648 end;\r
9649 \r
9650 function EqualWithoutSpaces( S1, S2: String ): Boolean;\r
9651 begin\r
9652   asm\r
9653     jmp @@e_signature\r
9654     DB '#$signature$#', 0\r
9655     DB 'EqualWithoutSpaces', 0\r
9656   @@e_signature:\r
9657   end;\r
9658   S1 := TrimAll( LowerCase( S1 ) );\r
9659   S2 := TrimAll( LowerCase( S2 ) );\r
9660   Result := S1 = S2;\r
9661 end;\r
9662 \r
9663 \r
9664 function TKOLForm.GeneratePAS(const Path: String; var Updated: Boolean): Boolean;\r
9665 const DefString = '{$DEFINE KOL_MCK}';\r
9666 var SL: TStringList;        // ñòðîêè ðåçóëüòèðóþùåãî PAS-ôàéëà\r
9667     Source: TStringList;    // èñõîäíûé ôàéë\r
9668     I, J, K: Integer;\r
9669     UsesFound, FormDefFound, ImplementationFound: Boolean;\r
9670     S, S1, S2: String;\r
9671 begin\r
9672   asm\r
9673     jmp @@e_signature\r
9674     DB '#$signature$#', 0\r
9675     DB 'TKOLForm.GeneratePAS', 0\r
9676   @@e_signature:\r
9677   end;\r
9678   Log( '->TKOLForm.GeneratePAS' );\r
9679   try\r
9680   Rpt( 'Generating PAS for ' + Path ); //Rpt_Stack;\r
9681   Result := False;\r
9682   // +++ by Alexander Shakhaylo:\r
9683   if not fileexists(Path + '.pas') or FLocked then\r
9684   begin\r
9685      LogOK; exit;\r
9686   end;\r
9687   // ---\r
9688   SL := TStringList.Create;\r
9689   Source := TStringList.Create;\r
9690 \r
9691   try\r
9692 \r
9693   SL.Add( Signature );\r
9694   SL.Add( '{ uses.inc' );\r
9695   SL.Add( '  This file is generated automatically - do not modify it manually.' );\r
9696   SL.Add( '  It is included to be recognized by compiler, but replacing word ' );\r
9697   SL.Add( '  <uses> with compiler directive <$I uses.inc> fakes auto-completion' );\r
9698   SL.Add( '  preventing it from automatic references adding to VCL units into' );\r
9699   SL.Add( '  uses clause aimed for KOL environment only. }' );\r
9700   SL.Add( '' );\r
9701   SL.Add( 'uses' );\r
9702   {P := True;\r
9703   if KOLProject <> nil then\r
9704     P := KOLProject.ProtectFiles;}\r
9705   SaveStrings( SL, ExtractFilePath( Path ) + 'uses.inc', Updated );\r
9706   SL.Clear;\r
9707 \r
9708   LoadSource( Source, Path + '.pas' );\r
9709   for I := 0 to Source.Count- 1 do\r
9710     if Source[ I ] = Signature then\r
9711     begin\r
9712       Result := True;\r
9713       if (I < Source.Count - 1) and (Source[ I + 1 ] <> DefString) and\r
9714          (KOLProject <> nil) and KOLProject.IsKOLProject then\r
9715       begin\r
9716         Source.Insert( I + 1, DefString );\r
9717         SaveStrings( Source, Path + '.pas', Updated );\r
9718       end;\r
9719       break;\r
9720     end;\r
9721 \r
9722   if Result then\r
9723   begin\r
9724     // Test the Source - may be form is renamed...\r
9725 \r
9726     for I := Source.Count - 2 downto 0 do\r
9727     begin\r
9728       S := Trim( Source[ I ] );\r
9729       if StrEq( S, '{$I MCKfakeClasses.inc}' ) then\r
9730       if I < Source.Count - 5 then\r
9731       begin\r
9732         Source[ I + 1 ] :=\r
9733           '  {$IFDEF KOLCLASSES} T' + FormName + ' = class; P' + FormName + ' = T' + FormName + ';' +\r
9734           ' {$ELSE OBJECTS}' +\r
9735           ' P' + FormName + ' = ^T' + FormName + ';' +\r
9736           ' {$ENDIF CLASSES/OBJECTS}';\r
9737         Source[ I + 2 ] :=\r
9738           '  {$IFDEF KOLCLASSES}{$I T' + FormName +\r
9739           '.inc}{$ELSE} T' + FormName +\r
9740           ' = object(TObj) {$ENDIF}';\r
9741         S := ExtractFilePath( Path ) + 'T' + FormName + '.inc';\r
9742         if not FileExists( S ) then\r
9743         begin\r
9744           SaveStringToFile( S, 'T' + FormName + ' = class(TObj)' );\r
9745         end;\r
9746         Source[ I + 5 ] := '  T' + FormName + ' = class(TForm)';\r
9747         //////////////////////// by Alexander Shakhaylo //////////////////\r
9748         if pos('{$ENDIF', UpperCase( Source[ I + 6 ] ) ) <= 0 then      //\r
9749         begin                                                           //\r
9750            Source.Insert( I + 6, '{$ENDIF}' );                          //\r
9751         end;                                                            //\r
9752         //////////////////////////////////////////////////////////////////\r
9753       end;\r
9754       ////////////////////////////////////////////////////////////////////\r
9755       S := UpperCase( 'T' + FormName + ' = class(TForm)' );             //\r
9756       if pos( S, UpperCase( Source[ I ] ) ) > 0 then                    //\r
9757       begin                                                             //\r
9758         if pos( '{$ENDIF', Source[ I + 1 ] ) <= 0 then                  //\r
9759           Source.Insert( I + 1, '  {$ENDIF KOL_MCK}' );                 //\r
9760       end;                                                              //\r
9761       ////////////////////////////////////////////////////////////////////\r
9762       S := ' {$IFDEF KOL_MCK} : ';\r
9763       if pos( S, UpperCase( Trim( Source[ I ] ) ) ) > 0 then\r
9764       begin\r
9765         Source[ I ] := '  ' + FormName + ' {$IFDEF KOL_MCK} : P' + FormName +\r
9766                        ' {$ELSE} : T' + FormName + ' {$ENDIF} ;';\r
9767       end;\r
9768       S := 'procedure new';\r
9769       if (UpperCase( Trim( Source[ I ] ) ) = '{$IFDEF KOL_MCK}') and\r
9770          (\r
9771          (LowerCase( Copy( Trim( Source[ I + 1 ] ), 1, Length( S ) ) ) = S)\r
9772          or\r
9773          (LowerCase( Copy( Trim( Source[ I + 1 ] ), 1, Length( 'function new' ) ) ) = 'function new')\r
9774          ) then\r
9775       begin\r
9776          Source[ I + 1 ] := 'procedure New' + FormName + '( var Result: P' +\r
9777          FormName + '; AParent: PControl );';\r
9778          ///////////////////////////// by Alexander Shakhaylo /////////\r
9779          if pos( '{$ENDIF', UpperCase( Source[ I + 2 ] ) ) <= 0 then //\r
9780            Source.Insert( I + 2, '{$ENDIF}');                        //\r
9781          //////////////////////////////////////////////////////////////\r
9782       end;\r
9783       if (UpperCase( Trim( Source[ I ] ) ) = '{$IFDEF KOL_MCK}') then\r
9784         if StrIsStartingFrom( PChar((UpperCase( Trim( Source[ I + 2 ] ) ))),\r
9785            'PROCEDURE FREEOBJECTS_') then\r
9786         begin\r
9787           // remove artefact\r
9788           Source.Delete( I + 2 );\r
9789         end;\r
9790     end;\r
9791 \r
9792 \r
9793     // Convert old definitions to the new ones\r
9794     K := -1;\r
9795     for I := 0 to Source.Count-3 do\r
9796     begin\r
9797       S := Trim( Source[ I ] );\r
9798       if S = '{$ELSE not_KOL_MCK}' then\r
9799       begin\r
9800         K := I;\r
9801         break;\r
9802       end;\r
9803     end;\r
9804 \r
9805     if K < 0 then\r
9806     begin\r
9807       for I := 0 to Source.Count-3 do\r
9808       begin\r
9809         S := UpperCase( Trim( Source[ I ] ) );\r
9810         if StrIsStartingFrom( PChar( S ), '{$I MCKFAKECLASSES.INC}' ) then\r
9811         begin\r
9812           for J := I+1 to Source.Count-3 do\r
9813           begin\r
9814             S := UpperCase( Trim( Source[ J ] ) );\r
9815             if Copy( S, 1, 6 )  = '{$ELSE' then\r
9816             begin\r
9817               Source[ J ] := '  {$ELSE not_KOL_MCK}';\r
9818               break;\r
9819             end;\r
9820           end;\r
9821           break;\r
9822         end;\r
9823       end;\r
9824     end;\r
9825 \r
9826     // Make corrections when Delphi inserts declarations not at the good place:\r
9827     for I := 0 to Source.Count-3 do\r
9828     begin\r
9829       S := Trim( Source[ I ] );\r
9830       if S = '{$ELSE not_KOL_MCK}' then\r
9831       begin\r
9832         S := Trim( Source[ I + 2 ] );\r
9833         if S <> '{$ENDIF KOL_MCK}' then\r
9834         begin\r
9835           for J := I+1 to Source.Count-1 do\r
9836           begin\r
9837             S := UpperCase( Trim( Source[ J ] ) );\r
9838             if Copy( S, 1, 7 ) = '{$ENDIF' then\r
9839             begin\r
9840               Source.Delete( J );\r
9841               Source.Insert( I+2, '  {$ENDIF KOL_MCK}' );\r
9842               break;\r
9843             end;\r
9844           end;\r
9845         end;\r
9846         break;\r
9847       end;\r
9848     end;\r
9849 \r
9850     //Check for changes in 'uses' clause:\r
9851     I := -1;\r
9852     while I < Source.Count - 1 do\r
9853     begin\r
9854       Inc( I );\r
9855 \r
9856       if StrEq( Trim( Source[ I ] ), 'implementation' ) then break;\r
9857 \r
9858       if (pos( 'uses ', LowerCase( Trim( Source[ I ] ) + ' ' ) ) = 1) then\r
9859       begin\r
9860         S := '';\r
9861         for J := I to Source.Count - 1 do\r
9862         begin\r
9863           S := S + Source[ J ];\r
9864           if pos( ';', Source[ J ] ) > 0 then\r
9865             break;\r
9866         end;\r
9867 \r
9868         S1 := 'uses Windows, Messages, ShellAPI, KOL' + AdditionalUnits;\r
9869         S2 := Parse( S, '{' ); S := '{' + S;\r
9870         if not EqualWithoutSpaces( S1, S2 ) then\r
9871         begin\r
9872 \r
9873           (*\r
9874           ShowMessage( 'Not equal:'#13#10 +\r
9875                        TrimAll( S1 ) + #13#10 +\r
9876                        TrimAll( S2 ) );\r
9877           *)\r
9878 \r
9879           repeat\r
9880             S1 := Source[ I ];\r
9881             Source.Delete( I );\r
9882           until pos( ';', S1 ) > 0;\r
9883 \r
9884           Source.Insert( I,\r
9885            'uses Windows, Messages, ShellAPI, KOL' + AdditionalUnits + ' ' +\r
9886            S );\r
9887 \r
9888         end;\r
9889 \r
9890         break;\r
9891       end;\r
9892     end;\r
9893 \r
9894     AfterGeneratePas( Source );\r
9895     SaveStrings( Source, Path + '.pas', Updated );\r
9896 \r
9897     SL.Free;\r
9898     Source.Free;\r
9899     LogOK;\r
9900     Exit;\r
9901   end;\r
9902 \r
9903   // Step 1. If unit is not yet prepared for working both\r
9904   // in KOL and VCL, then prepare it now.\r
9905   K := 0;\r
9906   for I := 0 to Source.Count - 1 do\r
9907     if pos( Signature, Source[ I ] ) > 0 then\r
9908     begin\r
9909       Inc( K );\r
9910       break;\r
9911     end;\r
9912   if K = 0 then\r
9913   begin\r
9914     UsesFound := False;\r
9915     FormDefFound := False;\r
9916     ImplementationFound := False;\r
9917     try\r
9918       SL.Add( Signature );\r
9919       for I := 0 to Source.Count - 1 do\r
9920       begin\r
9921         if pos( '{$r *.dfm}', LowerCase( Source[ I ] ) ) > 0 then\r
9922         begin\r
9923           Source[ I ] := '{$IFNDEF KOL_MCK} {$R *.DFM} {$ENDIF}';\r
9924           break;\r
9925         end;\r
9926       end;\r
9927       I := -1;\r
9928       while I < Source.Count - 1 do\r
9929       begin\r
9930         Inc( I );\r
9931         if not ImplementationFound then\r
9932         if not UsesFound and\r
9933            (pos( 'uses ', LowerCase( Trim( Source[ I ] ) + ' ' ) ) = 1) then\r
9934         begin\r
9935           UsesFound := True;\r
9936           SL.Add( '{$IFDEF KOL_MCK}' );\r
9937           SL.Add( 'uses Windows, Messages, ShellAPI, KOL' + AdditionalUnits + ' ' +\r
9938                   '{$IFNDEF KOL_MCK}, mirror, Classes, Controls, mckControls, ' +\r
9939                   'mckObjs, Graphics {$ENDIF};' );\r
9940           SL.Add( '{$ELSE}' );\r
9941           SL.Add( '{$I uses.inc}' + Copy( Source[ I ], 5, Length( Source[ I ] ) - 4 ) );\r
9942           Inc( I );\r
9943           if pos( ';', Source[ I - 1 ] ) < 1 then\r
9944           repeat\r
9945             SL.Add( Source[ I ] );\r
9946             Inc( I );\r
9947           until pos( ';', Source[ I - 1 ] ) > 0;\r
9948           SL.Add( '{$ENDIF}' );\r
9949           Dec( I );\r
9950           Continue;\r
9951         end;\r
9952         if not FormDefFound and\r
9953            (pos( LowerCase( 'T' + FormName + ' = class(TForm)' ),\r
9954                 LowerCase( Source[ I ] ) ) > 0) then\r
9955         begin\r
9956           FormDefFound := True;\r
9957           SL.Add( '  {$IFDEF KOL_MCK}' );\r
9958           S := '  {$I MCKfakeClasses.inc}';\r
9959           SL.Add( S );\r
9960           SL.Add( '  {$IFDEF KOLCLASSES} T' + FormName +\r
9961           ' = class; P' + FormName + ' = T' + FormName + ';' +\r
9962           ' {$ELSE OBJECTS}' +\r
9963           ' P' + FormName + ' = ^T' + FormName + ';' +\r
9964           ' {$ENDIF CLASSES/OBJECTS}' );\r
9965           SL.Add( '  {$IFDEF KOLCLASSES}{$I T' + FormName +\r
9966           '.inc}{$ELSE} T' + FormName +\r
9967           ' = object(TObj) {$ENDIF}' );\r
9968           SL.Add( '    Form: ' + FormTypeName + ';' );\r
9969           SL.Add( '  {$ELSE not_KOL_MCK}' );\r
9970           SL.Add( Source[ I ] );\r
9971           SL.Add( '  {$ENDIF KOL_MCK}' );\r
9972           Continue;\r
9973         end;\r
9974         if not ImplementationFound then\r
9975         begin\r
9976           if LowerCase( Trim( Source[ I ] ) ) =\r
9977              LowerCase( FormName + ': T' + FormName + ';' ) then\r
9978           begin\r
9979             SL.Add( '  ' + FormName + ' {$IFDEF KOL_MCK} : P' + FormName +\r
9980                     ' {$ELSE} : T' + FormName + ' {$ENDIF} ;' );\r
9981             Continue;\r
9982           end;\r
9983         end;\r
9984         if not ImplementationFound and\r
9985            (pos( 'implementation', LowerCase( Source[ I ] ) ) > 0 ) then\r
9986         begin\r
9987           SL.Add( '{$IFDEF KOL_MCK}' );\r
9988           SL.Add( 'procedure New' + FormName + '( var Result: P' + FormName +\r
9989                   '; AParent: PControl );' );\r
9990           SL.Add( '{$ENDIF}' );\r
9991           SL.Add( '' );\r
9992 \r
9993           ImplementationFound := True;\r
9994           SL.Add( Source[ I ] );\r
9995           while True do\r
9996           begin\r
9997             Inc( I );\r
9998             if pos( 'uses ', LowerCase( Source[ I ] + ' ' ) ) > 0 then\r
9999             begin\r
10000               SL.Add( Source[ I ] );\r
10001               if pos( ';', Source[ I ] ) < 1 then\r
10002               begin\r
10003                 repeat\r
10004                   Inc( I );\r
10005                   SL.Add( Source[ I ] );\r
10006                 until pos( ';', Source[ I ] ) > 0;\r
10007               end;\r
10008               ImplementationFound := False;\r
10009               break;\r
10010             end\r
10011                else\r
10012             if (Trim( Source[ I ] ) <> '') and (Trim( Source[ I ] )[ 1 ] <> '{') then\r
10013               break;\r
10014             SL.Add( Source[ I ] );\r
10015           end;\r
10016           if not ImplementationFound then\r
10017             SL.Add( '' );\r
10018           SL.Add( '{$IFDEF KOL_MCK}' );\r
10019           SL.Add( '{$I ' + FormUnit + '_1.inc}' );\r
10020           SL.Add( '{$ENDIF}' );\r
10021           if ImplementationFound then\r
10022           begin\r
10023             SL.Add( '' );\r
10024             SL.Add( Source[ I ] );\r
10025           end;\r
10026           ImplementationFound := True;\r
10027           Continue;\r
10028         end;\r
10029         SL.Add( Source[ I ] );\r
10030       end;\r
10031     except\r
10032       ImplementationFound := False;\r
10033     end;\r
10034     if not UsesFound or not FormDefFound or not ImplementationFound then\r
10035     begin\r
10036       SL.Free;\r
10037       Source.Free;\r
10038       S := '';\r
10039       if not UsesFound then\r
10040         S := 'Uses not found'#13;\r
10041       if not FormDefFound then\r
10042         S := S + 'Form definition not found'#13;\r
10043       if not ImplementationFound then\r
10044         S := S + 'Implementation section not found'#13;\r
10045       ShowMessage( 'Error converting ' + FormUnit + ' unit to KOL:'#13 + S );\r
10046       LogOK;\r
10047       Exit;\r
10048     end;\r
10049 \r
10050     AfterGeneratePas( SL );\r
10051     SaveStrings( SL, Path + '.pas', Updated );\r
10052   end;\r
10053 \r
10054   Result := True;\r
10055   except\r
10056     Rpt( '**************** Unknown Exception - supressed' );\r
10057   end;\r
10058 \r
10059   SL.Free;\r
10060   Source.Free;\r
10061   LogOK;\r
10062   finally\r
10063   Log( '<-TKOLForm.GeneratePAS' );\r
10064   end;\r
10065 end;\r
10066 \r
10067 function TKOLForm.GenerateTransparentInits: String;\r
10068 begin\r
10069   asm\r
10070     jmp @@e_signature\r
10071     DB '#$signature$#', 0\r
10072     DB 'TKOLForm.GenerateTransparentInits', 0\r
10073   @@e_signature:\r
10074   end;\r
10075   Log( '->TKOLForm.GenerateTransparentInits' );\r
10076   try\r
10077   Result := '';\r
10078   if not FLocked then\r
10079   begin\r
10080 \r
10081     //Log( '#1 TKOLForm.GenerateTransparentInits' );\r
10082 \r
10083     if not DefaultPosition then\r
10084     begin\r
10085       //Log( '#1.A TKOLForm.GenerateTransparentInits' );\r
10086 \r
10087       if not DoNotGenerateSetPosition then\r
10088       begin\r
10089         //Log( '#1.B TKOLForm.GenerateTransparentInits' );\r
10090         if FBounds <> nil then\r
10091           Result := '.SetPosition( ' + IntToStr( Bounds.Left ) + ', ' +\r
10092                     IntToStr( Bounds.Top ) + ' )';\r
10093         //Log( '#1.C TKOLForm.GenerateTransparentInits' );\r
10094       end;\r
10095 \r
10096       //Log( '#1.D TKOLForm.GenerateTransparentInits' );\r
10097     end;\r
10098 \r
10099     //Log( '#2 TKOLForm.GenerateTransparentInits' );\r
10100 \r
10101     if not DefaultSize then\r
10102     begin\r
10103       if {CanResize or} (Owner = nil) or not(Owner is TForm) then\r
10104         if HasCaption then\r
10105           Result := Result + '.SetSize( ' + IntToStr( Bounds.Width ) + ', ' +\r
10106                   IntToStr( Bounds.Height ) + ' )'\r
10107         else\r
10108           Result := Result + '.SetSize( ' + IntToStr( Bounds.Width ) + ', ' +\r
10109                   IntToStr( Bounds.Height-GetSystemMetrics(SM_CYCAPTION) ) + ' )'\r
10110       else\r
10111         if HasCaption then\r
10112           Result := Result + '.SetClientSize( ' + IntToStr( (Owner as TForm).ClientWidth ) +\r
10113                  ', ' + IntToStr( (Owner as TForm).ClientHeight ) + ' )'\r
10114         //+++++++ UaFM\r
10115         else\r
10116           Result := Result + '.SetClientSize( ' + IntToStr( (Owner as TForm).ClientWidth ) +\r
10117                  ', ' + IntToStr( (Owner as TForm).ClientHeight-GetSystemMetrics(SM_CYCAPTION) )\r
10118                  + ')'\r
10119     end;\r
10120 \r
10121     //Log( '#3 TKOLForm.GenerateTransparentInits' );\r
10122 \r
10123     if Tabulate then\r
10124       Result := Result + '.Tabulate'\r
10125     else\r
10126     if TabulateEx then\r
10127       Result := Result + '.TabulateEx';\r
10128 \r
10129     //Log( '#4 TKOLForm.GenerateTransparentInits' );\r
10130 \r
10131     {if AllBtnReturnClick then\r
10132       Result := Result + '.AllBtnReturnClick';}\r
10133 \r
10134     if PreventResizeFlicks then\r
10135       Result := Result + '.PreventResizeFlicks';\r
10136 \r
10137     //Log( '#5 TKOLForm.GenerateTransparentInits' );\r
10138 \r
10139     if supportMnemonics then\r
10140       Result := Result + '.SupportMnemonics';\r
10141 \r
10142     //Log( '#6 TKOLForm.GenerateTransparentInits' );\r
10143 \r
10144     if HelpContext <> 0 then\r
10145       Result := Result + '.AssignHelpContext( ' + IntToStr( HelpContext ) + ' )';\r
10146   end;\r
10147 \r
10148   //Log( '#7 TKOLForm.GenerateTransparentInits' );\r
10149 \r
10150   LogOK;\r
10151   finally\r
10152   Log( '<-TKOLForm.GenerateTransparentInits' );\r
10153   end;\r
10154 end;\r
10155 \r
10156 function TKOLForm.GenerateUnit(const Path: String): Boolean;\r
10157 var PAS, INC: Boolean;\r
10158     Updated, PasUpdated, IncUpdated: Boolean;\r
10159     I: Integer;\r
10160     C: TComponent;\r
10161 begin\r
10162   asm\r
10163     jmp @@e_signature\r
10164     DB '#$signature$#', 0\r
10165     DB 'TKOLForm.GenerateUnit', 0\r
10166   @@e_signature:\r
10167   end;\r
10168   Log( '->TKOLForm.GenerateUnit' );\r
10169   try\r
10170   Result := False;\r
10171 \r
10172   if not FLocked then\r
10173   begin\r
10174     for I := 0 to Owner.ComponentCount-1 do\r
10175     begin\r
10176       C := Owner.Components[ I ];\r
10177       if IsVCLControl( C ) then\r
10178       begin\r
10179         FLocked := TRUE;\r
10180         ShowMessage( 'Form ' + Owner.Name + ' contains VCL controls and can not ' +\r
10181                      'be converted to KOL form properly. TKOLForm component is locked. ' +\r
10182                      'Remove VCL controls first, then unlock TKOLForm component.' );\r
10183         LogOK;\r
10184         Exit;\r
10185       end;\r
10186     end;\r
10187 \r
10188     fUniqueID := 5000;\r
10189     Rpt( '*************** UNIQUE ID = ' + IntToStr( fUniqueID ) );\r
10190     if FormUnit = '' then\r
10191     begin\r
10192       Rpt( 'Error: FormUnit = ''''' );\r
10193       LogOK;\r
10194       Exit;\r
10195     end;\r
10196 \r
10197     PasUpdated := FALSE;\r
10198     IncUpdated := FALSE;\r
10199     PAS := GeneratePAS( Path, PasUpdated );\r
10200     INC := GenerateINC( Path, IncUpdated );\r
10201     Updated := PasUpdated or IncUpdated;\r
10202     Result := PAS and INC;\r
10203     if Result and Updated then\r
10204     begin\r
10205       // force mark modified here\r
10206       if PasUpdated then\r
10207         MarkModified( Path + '.pas' );\r
10208       if IncUpdated then\r
10209       begin\r
10210         MarkModified( Path + '_1.inc' );\r
10211         UpdateUnit( Path + '_1.inc' );\r
10212       end;\r
10213     end;\r
10214   end;\r
10215   LogOK;\r
10216   finally\r
10217   Log( '<-TKOLForm.GenerateUnit' );\r
10218   end;\r
10219 end;\r
10220 \r
10221 function TKOLForm.GetCaption: String;\r
10222 begin\r
10223   asm\r
10224     jmp @@e_signature\r
10225     DB '#$signature$#', 0\r
10226     DB 'TKOLForm.GetCaption', 0\r
10227   @@e_signature:\r
10228   end;\r
10229   Log( '->TKOLForm.GetCaption' );\r
10230   try\r
10231   Result := FCaption;\r
10232   if (Owner <> nil) and (Owner is TForm) then\r
10233     Result := (Owner as TForm).Caption;\r
10234   LogOK;\r
10235   finally\r
10236   Log( '<-TKOLForm.GetCaption' );\r
10237   end;\r
10238 end;\r
10239 \r
10240 function TKOLForm.GetFormMain: Boolean;\r
10241 begin\r
10242   asm\r
10243     jmp @@e_signature\r
10244     DB '#$signature$#', 0\r
10245     DB 'TKOLForm.GetFormMain', 0\r
10246   @@e_signature:\r
10247   end;\r
10248   Log( '->TKOLForm.GetFormMain' );\r
10249   try\r
10250   Result := fFormMain;\r
10251   if KOLProject <> nil then\r
10252     Result := KOLProject.Owner = Owner;\r
10253   LogOK;\r
10254   finally\r
10255   Log( '<-TKOLForm.GetFormMain' );\r
10256   end;\r
10257 end;\r
10258 \r
10259 function TKOLForm.GetFormName: String;\r
10260 begin\r
10261   asm\r
10262     jmp @@e_signature\r
10263     DB '#$signature$#', 0\r
10264     DB 'TKOLForm.GetFormName', 0\r
10265   @@e_signature:\r
10266   end;\r
10267   //Log( '->TKOLForm.GetFormName' );\r
10268   try\r
10269   Result := '';\r
10270   if Owner <> nil then\r
10271     Result := Owner.Name;\r
10272   LogOK;\r
10273   finally\r
10274   //Log( '<-TKOLForm.GetFormName' );\r
10275   end;\r
10276 end;\r
10277 \r
10278 var LastSrcLocatedWarningTime: Integer;\r
10279 \r
10280 function TKOLForm.GetFormUnit: String;\r
10281 var\r
10282     I, J: Integer;\r
10283     S, S1, S2: String;\r
10284     Dpr: TStringList;\r
10285 begin\r
10286   asm\r
10287     jmp @@e_signature\r
10288     DB '#$signature$#', 0\r
10289     DB 'TKOLForm.GetFormUnit', 0\r
10290   @@e_signature:\r
10291   end;\r
10292   //Log( '->TKOLForm.GetFormUnit' );\r
10293   try\r
10294   Result := fFormUnit;\r
10295   if Result = '' then\r
10296   if ProjectSourcePath <> '' then\r
10297   begin\r
10298     S := ProjectSourcePath;\r
10299     if S[ Length( S ) ] <> '\' then\r
10300       S := S + '\';\r
10301     S1 := S;\r
10302     S := S + Get_ProjectName + '.dpr';\r
10303     if FileExists( S ) then\r
10304     begin\r
10305       Dpr := TStringList.Create;\r
10306       LoadSource( Dpr, S );\r
10307       for I := 0 to Dpr.Count - 1 do\r
10308       begin\r
10309         S := Trim( Dpr[ I ] );\r
10310         J := pos( '{' + LowerCase( FormName ) + '}', LowerCase( S ) );\r
10311         if (J > 0) and (pos( '''', S ) > 0) then\r
10312         begin\r
10313           J := pos( '''', S );\r
10314           S := Copy( S, J + 1, Length( S ) - J );\r
10315           J := pos( '''', S );\r
10316           if J > 0 then\r
10317           begin\r
10318             S := Copy( S, 1, J - 1 );\r
10319             if pos( ':', S ) < 1 then\r
10320               S := S1 + S;\r
10321             S2 := ExtractFilePath( S );\r
10322             S := ExtractFileName( S );\r
10323             if (S2 <> '') and (LowerCase( S2 ) <> LowerCase( S1 )) then\r
10324             begin\r
10325               if Abs( Integer( GetTickCount ) - LastSrcLocatedWarningTime ) > 60000 then\r
10326               begin\r
10327                 LastSrcLocatedWarningTime := GetTickCount;\r
10328                 ShowMessage( 'Source unit ' + S + ' is located not in the same ' +\r
10329                              'directory as SourcePath of TKOLProject component. ' +\r
10330                              'This can cause problems with converting project.' );\r
10331               end;\r
10332               //LogOK;\r
10333               Exit;\r
10334             end;\r
10335             J := pos( '.', S );\r
10336             if J > 0 then S := Copy( S, 1, J - 1 );\r
10337             Result := S;\r
10338             fFormUnit := S;\r
10339             //LogOK;\r
10340             Exit;\r
10341           end;\r
10342         end;\r
10343       end;\r
10344       Dpr.Free;\r
10345     end;\r
10346   end;\r
10347   //LogOK;\r
10348   finally\r
10349   //Log( '<-TKOLForm.GetFormUnit' );\r
10350   end;\r
10351 end;\r
10352 \r
10353 function TKOLForm.GetSelf: TKOLForm;\r
10354 begin\r
10355   asm\r
10356     jmp @@e_signature\r
10357     DB '#$signature$#', 0\r
10358     DB 'TKOLForm.GetSelf', 0\r
10359   @@e_signature:\r
10360   end;\r
10361   Result := Self;\r
10362 end;\r
10363 \r
10364 function TKOLForm.Get_Color: TColor;\r
10365 begin\r
10366   asm\r
10367     jmp @@e_signature\r
10368     DB '#$signature$#', 0\r
10369     DB 'TKOLForm.Get_Color', 0\r
10370   @@e_signature:\r
10371   end;\r
10372   Log( '->TKOLForm.Get_Color' );\r
10373   try\r
10374   Result := (Owner as TForm).Color;\r
10375   LogOK;\r
10376   finally\r
10377   Log( '<-TKOLForm.Get_Color' );\r
10378   end;\r
10379 end;\r
10380 \r
10381 procedure TKOLForm.SetAlphaBlend(Value: Integer);\r
10382 begin\r
10383   asm\r
10384     jmp @@e_signature\r
10385     DB '#$signature$#', 0\r
10386     DB 'TKOLForm.SetAlphaBlend', 0\r
10387   @@e_signature:\r
10388   end;\r
10389   Log( '->TKOLForm.SetAlphaBlend' );\r
10390   try\r
10391   if not FLocked then\r
10392   begin\r
10393     if not (csLoading in ComponentState) then\r
10394       if Value = 0 then Value := 256;\r
10395     if Value < 0 then Value := 255;\r
10396     if Value > 256 then Value := 256;\r
10397     FAlphaBlend := Value;\r
10398     Change( Self );\r
10399   end;\r
10400   LogOK;\r
10401   finally\r
10402   Log( '<-TKOLForm.SetAlphaBlend' );\r
10403   end;\r
10404 end;\r
10405 \r
10406 procedure TKOLForm.SetCanResize(const Value: Boolean);\r
10407 begin\r
10408   asm\r
10409     jmp @@e_signature\r
10410     DB '#$signature$#', 0\r
10411     DB 'TKOLForm.SetCanResize', 0\r
10412   @@e_signature:\r
10413   end;\r
10414   Log( '->TKOLForm.SetCanResize' );\r
10415   try\r
10416   if not FLocked then\r
10417   begin\r
10418     fCanResize := Value;\r
10419   {YS}\r
10420     if (FborderStyle = fbsDialog) and Value then\r
10421       FborderStyle := fbsSingle;\r
10422   {YS}\r
10423     Change( Self );\r
10424   end;\r
10425   LogOK;\r
10426   finally\r
10427   Log( '<-TKOLForm.SetCanResize' );\r
10428   end;\r
10429 end;\r
10430 \r
10431 procedure TKOLForm.SetCenterOnScr(const Value: Boolean);\r
10432 begin\r
10433   asm\r
10434     jmp @@e_signature\r
10435     DB '#$signature$#', 0\r
10436     DB 'TKOLForm.SetCenterOnScr', 0\r
10437   @@e_signature:\r
10438   end;\r
10439   Log( '->TKOLForm.SetCenterOnScr' );\r
10440   try\r
10441   if not FLocked then\r
10442   begin\r
10443     fCenterOnScr := Value;\r
10444     Change( Self );\r
10445   end;\r
10446   LogOK;\r
10447   finally\r
10448   Log( '<-TKOLForm.SetCenterOnScr' );\r
10449   end;\r
10450 end;\r
10451 \r
10452 procedure TKOLForm.SetCloseIcon(const Value: Boolean);\r
10453 begin\r
10454   asm\r
10455     jmp @@e_signature\r
10456     DB '#$signature$#', 0\r
10457     DB 'TKOLForm.SetCloseIcon', 0\r
10458   @@e_signature:\r
10459   end;\r
10460   Log( '->TKOLForm.SetCloseIcon' );\r
10461   try\r
10462   if not FLocked then\r
10463   begin\r
10464     FCloseIcon := Value;\r
10465     Change( Self );\r
10466   end;\r
10467   LogOK;\r
10468   finally\r
10469   Log( '<-TKOLForm.SetCloseIcon' );\r
10470   end;\r
10471 end;\r
10472 \r
10473 procedure TKOLForm.SetCtl3D(const Value: Boolean);\r
10474 begin\r
10475   asm\r
10476     jmp @@e_signature\r
10477     DB '#$signature$#', 0\r
10478     DB 'TKOLForm.SetCtl3D', 0\r
10479   @@e_signature:\r
10480   end;\r
10481   Log( '->TKOLForm.SetCtl3D' );\r
10482   try\r
10483   if not FLocked then\r
10484   begin\r
10485     FCtl3D := Value;\r
10486     (Owner as TForm).Ctl3D := Value;\r
10487     (Owner as TForm).Invalidate;\r
10488     Change( Self );\r
10489   end;\r
10490   LogOK;\r
10491   finally\r
10492   Log( '<-TKOLForm.SetCtl3D' );\r
10493   end;\r
10494 end;\r
10495 \r
10496 procedure TKOLForm.SetCursor(const Value: String);\r
10497 begin\r
10498   asm\r
10499     jmp @@e_signature\r
10500     DB '#$signature$#', 0\r
10501     DB 'TKOLForm.SetCursor', 0\r
10502   @@e_signature:\r
10503   end;\r
10504   Log( '->TKOLForm.SetCursor' );\r
10505   try\r
10506   if FLocked then\r
10507   begin\r
10508     FCursor := UpperCase( Value );\r
10509     Change( Self );\r
10510   end;\r
10511   LogOK;\r
10512   finally\r
10513   Log( '<-TKOLForm.SetCursor' );\r
10514   end;\r
10515 end;\r
10516 \r
10517 procedure TKOLForm.SetDefaultPos(const Value: Boolean);\r
10518 begin\r
10519   asm\r
10520     jmp @@e_signature\r
10521     DB '#$signature$#', 0\r
10522     DB 'TKOLForm.SetDefaultPos', 0\r
10523   @@e_signature:\r
10524   end;\r
10525   Log( '->TKOLForm.SetDefaultPos' );\r
10526   try\r
10527   if not FLocked then\r
10528   begin\r
10529     fDefaultPos := Value;\r
10530     Change( Self );\r
10531   end;\r
10532   LogOK;\r
10533   finally\r
10534   Log( '<-TKOLForm.SetDefaultPos' );\r
10535   end;\r
10536 end;\r
10537 \r
10538 procedure TKOLForm.SetDefaultSize(const Value: Boolean);\r
10539 begin\r
10540   asm\r
10541     jmp @@e_signature\r
10542     DB '#$signature$#', 0\r
10543     DB 'TKOLForm.SetDefaultSize', 0\r
10544   @@e_signature:\r
10545   end;\r
10546   Log( '->TKOLForm.SetDefaultSize' );\r
10547   try\r
10548   if not FLocked then\r
10549   begin\r
10550     fDefaultSize := Value;\r
10551     Change( Self );\r
10552   end;\r
10553   LogOK;\r
10554   finally\r
10555   Log( '<-TKOLForm.SetDefaultSize' );\r
10556   end;\r
10557 end;\r
10558 \r
10559 procedure TKOLForm.SetDoubleBuffered(const Value: Boolean);\r
10560 begin\r
10561   asm\r
10562     jmp @@e_signature\r
10563     DB '#$signature$#', 0\r
10564     DB 'TKOLForm.SetDoubleBuffered', 0\r
10565   @@e_signature:\r
10566   end;\r
10567   Log( '->TKOLForm.SetDoubleBuffered' );\r
10568   try\r
10569 \r
10570   if not FLocked then\r
10571   begin\r
10572     FDoubleBuffered := Value;\r
10573     Change( Self );\r
10574   end;\r
10575   LogOK;\r
10576   finally\r
10577   Log( '<-TKOLForm.SetDoubleBuffered' );\r
10578   end;\r
10579 end;\r
10580 \r
10581 procedure TKOLForm.SetFont(const Value: TKOLFont);\r
10582 begin\r
10583   asm\r
10584     jmp @@e_signature\r
10585     DB '#$signature$#', 0\r
10586     DB 'TKOLForm.SetFont', 0\r
10587   @@e_signature:\r
10588   end;\r
10589   Log( '->TKOLForm.SetFont' );\r
10590   try\r
10591 \r
10592   if not FLocked and not fFont.Equal2( Value ) then\r
10593   begin\r
10594     CollectChildrenWithParentFont;\r
10595     fFont.Assign( Value );\r
10596     ApplyFontToChildren;\r
10597   end;\r
10598 \r
10599   LogOK;\r
10600   finally\r
10601   Log( '<-TKOLForm.SetFont' );\r
10602   end;\r
10603 end;\r
10604 \r
10605 procedure TKOLForm.SetFormCaption(const Value: String);\r
10606 begin\r
10607   asm\r
10608     jmp @@e_signature\r
10609     DB '#$signature$#', 0\r
10610     DB 'TKOLForm.SetFormCaption', 0\r
10611   @@e_signature:\r
10612   end;\r
10613   Log( '->TKOLForm.SetFormCaption' );\r
10614   try\r
10615 \r
10616   if FLocked then\r
10617   begin\r
10618     inherited Caption := Value;\r
10619     if (Owner <> nil) and (Owner is TForm) then\r
10620       (Owner as TForm).Caption := Value;\r
10621   end;\r
10622   LogOK;\r
10623   finally\r
10624   Log( '<-TKOLForm.SetFormCaption' );\r
10625   end;\r
10626 end;\r
10627 \r
10628 procedure TKOLForm.SetFormMain(const Value: Boolean);\r
10629 var I: Integer;\r
10630     F: TKOLForm;\r
10631 begin\r
10632   asm\r
10633     jmp @@e_signature\r
10634     DB '#$signature$#', 0\r
10635     DB 'TKOLForm.SetFormMain', 0\r
10636   @@e_signature:\r
10637   end;\r
10638   Log( '->TKOLForm.SetFormMain' );\r
10639   try\r
10640 \r
10641   if not FLocked then\r
10642   begin\r
10643 \r
10644     if fFormMain <> Value then\r
10645     begin\r
10646       if Value then\r
10647       begin\r
10648         for I := 0 to FormsList.Count - 1 do\r
10649         begin\r
10650           F := FormsList[ I ];\r
10651           if F <> Self then\r
10652             F.FormMain := False;\r
10653         end;\r
10654       end;\r
10655       fFormMain := Value;\r
10656       Change( Self );\r
10657     end;\r
10658 \r
10659   end;\r
10660 \r
10661   LogOK;\r
10662   finally\r
10663   Log( '<-TKOLForm.SetFormMain' );\r
10664   end;\r
10665 end;\r
10666 \r
10667 procedure TKOLForm.SetFormName(const Value: String);\r
10668 begin\r
10669   asm\r
10670     jmp @@e_signature\r
10671     DB '#$signature$#', 0\r
10672     DB 'TKOLForm.SetFormName', 0\r
10673   @@e_signature:\r
10674   end;\r
10675   Log( '->TKOLForm.SetFormName' );\r
10676   try\r
10677 \r
10678   if not FLocked then\r
10679   begin\r
10680 \r
10681     if KOLProject = nil then\r
10682     if (Value <> FormName) and (Value <> '') and (FormName <> '') then\r
10683     begin\r
10684       ShowMessage( 'Form name can not be changed properly, if main form (form with ' +\r
10685                    'TKOLProject component on it) is not opened in designer.'#13 +\r
10686                    'Operation failed.' );\r
10687       LogOK;\r
10688       Exit;\r
10689     end;\r
10690     if Owner <> nil then\r
10691     try\r
10692       Owner.Name := Value;\r
10693       Change( Self );\r
10694     except\r
10695       ShowMessage( 'Name "' + Value + '" can not be used as a name for form '+\r
10696                    'variable. Use another one, please.' );\r
10697       LogOK;\r
10698       exit;\r
10699     end;\r
10700 \r
10701   end;\r
10702 \r
10703   LogOK;\r
10704   finally\r
10705   Log( '<-TKOLForm.SetFormName' );\r
10706   end;\r
10707 end;\r
10708 \r
10709 \r
10710 procedure TKOLForm.SetFormUnit(const Value: String);\r
10711 begin\r
10712   asm\r
10713     jmp @@e_signature\r
10714     DB '#$signature$#', 0\r
10715     DB 'TKOLForm.SetFormUnit', 0\r
10716   @@e_signature:\r
10717   end;\r
10718   Log( '->TKOLForm.SetFormUnit' );\r
10719   try\r
10720 \r
10721   if not FLocked then\r
10722   begin\r
10723     fFormUnit := Value;\r
10724     Change( Self );\r
10725   end;\r
10726 \r
10727   LogOK;\r
10728   finally\r
10729   Log( '<-TKOLForm.SetFormUnit' );\r
10730   end;\r
10731 end;\r
10732 \r
10733 procedure TKOLForm.SetHasBorder(const Value: Boolean);\r
10734 begin\r
10735   asm\r
10736     jmp @@e_signature\r
10737     DB '#$signature$#', 0\r
10738     DB 'TKOLForm.SetHasBorder', 0\r
10739   @@e_signature:\r
10740   end;\r
10741   Log( '->TKOLForm.SetHasBorder' );\r
10742   try\r
10743 \r
10744   if not FLocked then\r
10745   begin\r
10746     FHasBorder := Value;\r
10747   {YS}\r
10748     if not Value then\r
10749       FborderStyle := fbsNone\r
10750     else\r
10751       if FborderStyle = fbsNone then\r
10752         FborderStyle := fbsSingle;\r
10753   {YS}\r
10754     Change( Self );\r
10755   end;\r
10756 \r
10757   LogOK;\r
10758   finally\r
10759   Log( '<-TKOLForm.SetHasBorder' );\r
10760   end;\r
10761 end;\r
10762 \r
10763 procedure TKOLForm.SetHasCaption(const Value: Boolean);\r
10764 begin\r
10765   asm\r
10766     jmp @@e_signature\r
10767     DB '#$signature$#', 0\r
10768     DB 'TKOLForm.SetHasCaption', 0\r
10769   @@e_signature:\r
10770   end;\r
10771   Log( '->TKOLForm.SetHasCaption' );\r
10772   try\r
10773 \r
10774   if not FLocked then\r
10775   begin\r
10776     FHasCaption := Value;\r
10777     Change( Self );\r
10778   end;\r
10779 \r
10780   LogOK;\r
10781   finally\r
10782   Log( '<-TKOLForm.SetHasCaption' );\r
10783   end;\r
10784 end;\r
10785 \r
10786 procedure TKOLForm.SetIcon(const Value: String);\r
10787 begin\r
10788   asm\r
10789     jmp @@e_signature\r
10790     DB '#$signature$#', 0\r
10791     DB 'TKOLForm.SetIcon', 0\r
10792   @@e_signature:\r
10793   end;\r
10794   Log( '->TKOLForm.SetIcon' );\r
10795   try\r
10796 \r
10797   if not FLocked then\r
10798   begin\r
10799     FIcon := UpperCase( Value );\r
10800     Change( Self );\r
10801   end;\r
10802 \r
10803   LogOK;\r
10804   finally\r
10805   Log( '<-TKOLForm.SetIcon' );\r
10806   end;\r
10807 end;\r
10808 \r
10809 procedure TKOLForm.SetMargin(const Value: Integer);\r
10810 begin\r
10811   asm\r
10812     jmp @@e_signature\r
10813     DB '#$signature$#', 0\r
10814     DB 'TKOLForm.SetMargin', 0\r
10815   @@e_signature:\r
10816   end;\r
10817   Log( '->TKOLForm.SetMargin' );\r
10818   try\r
10819 \r
10820   if not FLocked then\r
10821   begin\r
10822     if fMargin <> Value then\r
10823     begin\r
10824       fMargin := Value;\r
10825       AlignChildren( nil, FALSE );\r
10826       Change( Self );\r
10827     end;\r
10828     // Invalidate;\r
10829   end;\r
10830 \r
10831   LogOK;\r
10832   finally\r
10833   Log( '<-TKOLForm.SetMargin' );\r
10834   end;\r
10835 end;\r
10836 \r
10837 procedure TKOLForm.SetMaximizeIcon(const Value: Boolean);\r
10838 begin\r
10839   asm\r
10840     jmp @@e_signature\r
10841     DB '#$signature$#', 0\r
10842     DB 'TKOLForm.SetMaximizeIcon', 0\r
10843   @@e_signature:\r
10844   end;\r
10845   Log( '->TKOLForm.SetMaximizeIcon' );\r
10846   try\r
10847 \r
10848   if not FLocked then\r
10849   begin\r
10850     FMaximizeIcon := Value;\r
10851     if Value then\r
10852       helpContextIcon := FALSE;\r
10853     Change( Self );\r
10854   end;\r
10855 \r
10856   LogOK;\r
10857   finally\r
10858   Log( '<-TKOLForm.SetMaximizeIcon' );\r
10859   end;\r
10860 end;\r
10861 \r
10862 procedure TKOLForm.SetMinimizeIcon(const Value: Boolean);\r
10863 begin\r
10864   asm\r
10865     jmp @@e_signature\r
10866     DB '#$signature$#', 0\r
10867     DB 'TKOLForm.SetMinimizeIcon', 0\r
10868   @@e_signature:\r
10869   end;\r
10870   Log( '->TKOLForm.SetMinimizeIcon' );\r
10871   try\r
10872 \r
10873   if not FLocked then\r
10874   begin\r
10875     FMinimizeIcon := Value;\r
10876     if Value then\r
10877       helpContextIcon := FALSE;\r
10878     Change( Self );\r
10879   end;\r
10880 \r
10881   LogOK;\r
10882   finally\r
10883   Log( '<-TKOLForm.SetMinimizeIcon' );\r
10884   end;\r
10885 end;\r
10886 \r
10887 procedure TKOLForm.SetModalResult(const Value: Integer);\r
10888 begin\r
10889   asm\r
10890     jmp @@e_signature\r
10891     DB '#$signature$#', 0\r
10892     DB 'TKOLForm.SetModalResult', 0\r
10893   @@e_signature:\r
10894   end;\r
10895   Log( '->TKOLForm.SetModalResult' );\r
10896   try\r
10897 \r
10898   if not FLocked then\r
10899     FModalResult := Value;\r
10900 \r
10901   LogOK;\r
10902   finally\r
10903   Log( '<-TKOLForm.SetModalResult' );\r
10904   end;\r
10905 end;\r
10906 \r
10907 procedure TKOLForm.SetOnChar(const Value: TOnChar);\r
10908 begin\r
10909   asm\r
10910     jmp @@e_signature\r
10911     DB '#$signature$#', 0\r
10912     DB 'TKOLForm.SetOnChar', 0\r
10913   @@e_signature:\r
10914   end;\r
10915   Log( '->TKOLForm.SetOnChar' );\r
10916   try\r
10917 \r
10918   if not FLocked then\r
10919   begin\r
10920     FOnChar := Value;\r
10921     Change( Self );\r
10922   end;\r
10923 \r
10924   LogOK;\r
10925   finally\r
10926   Log( '<-TKOLForm.SetOnChar' );\r
10927   end;\r
10928 end;\r
10929 \r
10930 procedure TKOLForm.SetOnClick(const Value: TOnEvent);\r
10931 begin\r
10932   asm\r
10933     jmp @@e_signature\r
10934     DB '#$signature$#', 0\r
10935     DB 'TKOLForm.SetOnClick', 0\r
10936   @@e_signature:\r
10937   end;\r
10938   Log( '->TKOLForm.SetOnClick' );\r
10939   try\r
10940 \r
10941   if not FLocked then\r
10942   begin\r
10943     fOnClick := Value;\r
10944     Change( Self );\r
10945   end;\r
10946 \r
10947   LogOK;\r
10948   finally\r
10949   Log( '<-TKOLForm.SetOnClick' );\r
10950   end;\r
10951 end;\r
10952 \r
10953 procedure TKOLForm.SetOnFormCreate(const Value: TOnEvent);\r
10954 begin\r
10955   asm\r
10956     jmp @@e_signature\r
10957     DB '#$signature$#', 0\r
10958     DB 'TKOLForm.SetOnFormCreate', 0\r
10959   @@e_signature:\r
10960   end;\r
10961   Log( '->TKOLForm.SetOnFormCreate' );\r
10962   try\r
10963 \r
10964   if not FLocked then\r
10965   begin\r
10966     FOnFormCreate := Value;\r
10967     Change( Self );\r
10968   end;\r
10969 \r
10970   LogOK;\r
10971   finally\r
10972   Log( '<-TKOLForm.SetOnFormCreate' );\r
10973   end;\r
10974 end;\r
10975 \r
10976 procedure TKOLForm.SetOnEnter(const Value: TOnEvent);\r
10977 begin\r
10978   asm\r
10979     jmp @@e_signature\r
10980     DB '#$signature$#', 0\r
10981     DB 'TKOLForm.SetOnEnter', 0\r
10982   @@e_signature:\r
10983   end;\r
10984   Log( '->TKOLForm.SetOnEnter' );\r
10985   try\r
10986 \r
10987   if not FLocked then\r
10988   begin\r
10989     FOnEnter := Value;\r
10990     Change( Self );\r
10991   end;\r
10992 \r
10993   LogOK;\r
10994   finally\r
10995   Log( '<-TKOLForm.SetOnEnter' );\r
10996   end;\r
10997 end;\r
10998 \r
10999 procedure TKOLForm.SetOnKeyDown(const Value: TOnKey);\r
11000 begin\r
11001   asm\r
11002     jmp @@e_signature\r
11003     DB '#$signature$#', 0\r
11004     DB 'TKOLForm.SetOnKeyDown', 0\r
11005   @@e_signature:\r
11006   end;\r
11007   Log( '->TKOLForm.SetOnKeyDown' );\r
11008   try\r
11009 \r
11010   if not FLocked then\r
11011   begin\r
11012     FOnKeyDown := Value;\r
11013     Change( Self );\r
11014   end;\r
11015 \r
11016   LogOK;\r
11017   finally\r
11018   Log( '<-TKOLForm.SetOnKeyDown' );\r
11019   end;\r
11020 end;\r
11021 \r
11022 procedure TKOLForm.SetOnKeyUp(const Value: TOnKey);\r
11023 begin\r
11024   asm\r
11025     jmp @@e_signature\r
11026     DB '#$signature$#', 0\r
11027     DB 'TKOLForm.SetOnKeyUp', 0\r
11028   @@e_signature:\r
11029   end;\r
11030   Log( '->TKOLForm.SetOnKeyUp' );\r
11031   try\r
11032 \r
11033   if not FLocked then\r
11034   begin\r
11035     FOnKeyUp := Value;\r
11036     Change( Self );\r
11037   end;\r
11038 \r
11039   LogOK;\r
11040   finally\r
11041   Log( '<-TKOLForm.SetOnKeyUp' );\r
11042   end;\r
11043 end;\r
11044 \r
11045 procedure TKOLForm.SetOnLeave(const Value: TOnEvent);\r
11046 begin\r
11047   asm\r
11048     jmp @@e_signature\r
11049     DB '#$signature$#', 0\r
11050     DB 'TKOLForm.SetOnLeave', 0\r
11051   @@e_signature:\r
11052   end;\r
11053   Log( '->TKOLForm.SetOnLeave' );\r
11054   try\r
11055 \r
11056   if not FLocked then\r
11057   begin\r
11058     FOnLeave := Value;\r
11059     Change( Self );\r
11060   end;\r
11061 \r
11062   LogOK;\r
11063   finally\r
11064   Log( '<-TKOLForm.SetOnLeave' );\r
11065   end;\r
11066 end;\r
11067 \r
11068 procedure TKOLForm.SetOnMouseDown(const Value: TOnMouse);\r
11069 begin\r
11070   asm\r
11071     jmp @@e_signature\r
11072     DB '#$signature$#', 0\r
11073     DB 'TKOLForm.SetOnMouseDown', 0\r
11074   @@e_signature:\r
11075   end;\r
11076   Log( '->TKOLForm.SetOnMouseDown' );\r
11077   try\r
11078 \r
11079   if not FLocked then\r
11080   begin\r
11081     FOnMouseDown := Value;\r
11082     Change( Self );\r
11083   end;\r
11084 \r
11085   LogOK;\r
11086   finally\r
11087   Log( '<-TKOLForm.SetOnMouseDown' );\r
11088   end;\r
11089 end;\r
11090 \r
11091 procedure TKOLForm.SetOnMouseEnter(const Value: TOnEvent);\r
11092 begin\r
11093   asm\r
11094     jmp @@e_signature\r
11095     DB '#$signature$#', 0\r
11096     DB 'TKOLForm.SetOnMouseEnter', 0\r
11097   @@e_signature:\r
11098   end;\r
11099   Log( '->TKOLForm.SetOnMouseEnter' );\r
11100   try\r
11101 \r
11102   if not FLocked then\r
11103   begin\r
11104     FOnMouseEnter := Value;\r
11105     Change( Self );\r
11106   end;\r
11107 \r
11108   LogOK;\r
11109   finally\r
11110   Log( '<-TKOLForm.SetOnMouseEnter' );\r
11111   end;\r
11112 end;\r
11113 \r
11114 procedure TKOLForm.SetOnMouseLeave(const Value: TOnEvent);\r
11115 begin\r
11116   asm\r
11117     jmp @@e_signature\r
11118     DB '#$signature$#', 0\r
11119     DB 'TKOLForm.SetOnMouseLeave', 0\r
11120   @@e_signature:\r
11121   end;\r
11122   Log( '->TKOLForm.SetOnMouseLeave' );\r
11123   try\r
11124 \r
11125   if not FLocked then\r
11126   begin\r
11127     FOnMouseLeave := Value;\r
11128     Change( Self );\r
11129   end;\r
11130 \r
11131   LogOK;\r
11132   finally\r
11133   Log( '<-TKOLForm.SetOnMouseLeave' );\r
11134   end;\r
11135 end;\r
11136 \r
11137 procedure TKOLForm.SetOnMouseMove(const Value: TOnMouse);\r
11138 begin\r
11139   asm\r
11140     jmp @@e_signature\r
11141     DB '#$signature$#', 0\r
11142     DB 'TKOLForm.SetOnMouseMove', 0\r
11143   @@e_signature:\r
11144   end;\r
11145   Log( '->TKOLForm.SetOnMouseMove' );\r
11146   try\r
11147 \r
11148   if not FLocked then\r
11149   begin\r
11150   FOnMouseMove := Value;\r
11151   Change( Self );\r
11152   end;\r
11153 \r
11154   LogOK;\r
11155   finally\r
11156   Log( '<-TKOLForm.SetOnMouseMove' );\r
11157   end;\r
11158 end;\r
11159 \r
11160 procedure TKOLForm.SetOnMouseUp(const Value: TOnMouse);\r
11161 begin\r
11162   asm\r
11163     jmp @@e_signature\r
11164     DB '#$signature$#', 0\r
11165     DB 'TKOLForm.SetOnMouseUp', 0\r
11166   @@e_signature:\r
11167   end;\r
11168   Log( '->TKOLForm.SetOnMouseUp' );\r
11169   try\r
11170 \r
11171   if not FLocked then\r
11172   begin\r
11173   FOnMouseUp := Value;\r
11174   Change( Self );\r
11175   end;\r
11176 \r
11177   LogOK;\r
11178   finally\r
11179   Log( '<-TKOLForm.SetOnMouseUp' );\r
11180   end;\r
11181 end;\r
11182 \r
11183 procedure TKOLForm.SetOnMouseWheel(const Value: TOnMouse);\r
11184 begin\r
11185   asm\r
11186     jmp @@e_signature\r
11187     DB '#$signature$#', 0\r
11188     DB 'TKOLForm.SetOnMouseWheel', 0\r
11189   @@e_signature:\r
11190   end;\r
11191   Log( '->TKOLForm.SetOnMouseWheel' );\r
11192   try\r
11193 \r
11194   if not FLocked then\r
11195   begin\r
11196   FOnMouseWheel := Value;\r
11197   Change( Self );\r
11198   end;\r
11199 \r
11200   LogOK;\r
11201   finally\r
11202   Log( '<-TKOLForm.SetOnMouseWheel' );\r
11203   end;\r
11204 end;\r
11205 \r
11206 procedure TKOLForm.SetOnResize(const Value: TOnEvent);\r
11207 begin\r
11208   asm\r
11209     jmp @@e_signature\r
11210     DB '#$signature$#', 0\r
11211     DB 'TKOLForm.SetOnResize', 0\r
11212   @@e_signature:\r
11213   end;\r
11214   Log( 'TKOLForm.SetOnResize' );\r
11215   try\r
11216 \r
11217   if not FLocked then\r
11218   begin\r
11219   FOnResize := Value;\r
11220   Change( Self );\r
11221   end;\r
11222 \r
11223   LogOK;\r
11224   finally\r
11225   Log( '<-OLForm.SetOnResize' );\r
11226   end;\r
11227 end;\r
11228 \r
11229 procedure TKOLForm.SetPreventResizeFlicks(const Value: Boolean);\r
11230 begin\r
11231   asm\r
11232     jmp @@e_signature\r
11233     DB '#$signature$#', 0\r
11234     DB 'TKOLForm.SetPreventResizeFlicks', 0\r
11235   @@e_signature:\r
11236   end;\r
11237   Log( '->TKOLForm.PreventResizeFlicks' );\r
11238   try\r
11239 \r
11240   if not FLocked then\r
11241   begin\r
11242   FPreventResizeFlicks := Value;\r
11243   Change( Self );\r
11244   end;\r
11245 \r
11246   LogOK;\r
11247   finally\r
11248   Log( '<-TKOLForm.PreventResizeFlicks' );\r
11249   end;\r
11250 end;\r
11251 \r
11252 procedure TKOLForm.SetStayOnTop(const Value: Boolean);\r
11253 begin\r
11254   asm\r
11255     jmp @@e_signature\r
11256     DB '#$signature$#', 0\r
11257     DB 'TKOLForm.SetStayOnTop', 0\r
11258   @@e_signature:\r
11259   end;\r
11260   Log( '->TKOLForm.SetStayOnTop' );\r
11261   try\r
11262 \r
11263   if not FLocked then\r
11264   begin\r
11265   FStayOnTop := Value;\r
11266   Change( Self );\r
11267   end;\r
11268 \r
11269   LogOK;\r
11270   finally\r
11271   Log( '<-TKOLForm.SetStayOnTop' );\r
11272   end;\r
11273 end;\r
11274 \r
11275 procedure TKOLForm.SetTransparent(const Value: Boolean);\r
11276 begin\r
11277   asm\r
11278     jmp @@e_signature\r
11279     DB '#$signature$#', 0\r
11280     DB 'TKOLForm.SetTransparent', 0\r
11281   @@e_signature:\r
11282   end;\r
11283   Log( '->TKOLForm.SetTransparent' );\r
11284   try\r
11285 \r
11286   if not FLocked then\r
11287   begin\r
11288   FTransparent := Value;\r
11289   Change( Self );\r
11290   end;\r
11291 \r
11292   LogOK;\r
11293   finally\r
11294   Log( '<-TKOLForm.SetTransparent' );\r
11295   end;\r
11296 end;\r
11297 \r
11298 const BrushStyles: array[ TBrushStyle ] of String = ( 'bsSolid', 'bsClear',\r
11299       'bsHorizontal', 'bsVertical', 'bsFDiagonal', 'bsBDiagonal', 'bsCross',\r
11300       'bsDiagCross' );\r
11301 procedure TKOLForm.SetupFirst(SL: TStringList; const AName,\r
11302   AParent, Prefix: String);\r
11303 const WindowStates: array[ KOL.TWindowState ] of String = ( 'wsNormal',\r
11304       'wsMinimized', 'wsMaximized' );\r
11305 var I: Integer;\r
11306     S: string; {YS}\r
11307 begin\r
11308   asm\r
11309     jmp @@e_signature\r
11310     DB '#$signature$#', 0\r
11311     DB 'TKOLForm.SetupFirst', 0\r
11312   @@e_signature:\r
11313   end;\r
11314   Log( '->TKOLForm.SetupFirst' );\r
11315   try\r
11316 \r
11317   if FLocked then\r
11318   begin\r
11319     LogOK;\r
11320     Exit;\r
11321   end;\r
11322 \r
11323   //Log( '&1 TKOLForm.SetupFirst' );\r
11324 \r
11325   // Óñòàíîâêà êàêèõ-ëèáî ñâîéñòâ ôîðìû - òåõ, êîòîðûå âûïîëíÿþòñÿ\r
11326   // ñðàçó ïîñëå êîíñòðóèðîâàíèÿ îáúåêòà ôîðìû:\r
11327   if Tag <> 0 then\r
11328   begin\r
11329     if Tag < 0 then\r
11330       SL.Add( Prefix + AName + '.Tag := DWORD(' + Int2Str( Tag ) + ');' )\r
11331     else\r
11332       SL.Add( Prefix + AName + '.Tag := ' + Int2Str( Tag ) + ';' );\r
11333   end;\r
11334 \r
11335   //Log( '&2 TKOLForm.SetupFirst' );\r
11336 \r
11337   if not statusSizeGrip then\r
11338   //if (StatusText.Count > 0) or (SimpleStatusText <> '') then\r
11339     SL.Add( Prefix + AName + '.SizeGrip := FALSE;' );\r
11340 \r
11341   //Log( '&3 TKOLForm.SetupFirst' );\r
11342 \r
11343 {YS}\r
11344   S := '';\r
11345   case FborderStyle of\r
11346     fbsDialog:\r
11347       S := S + ' or WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE';\r
11348     fbsToolWindow:\r
11349       S := S + ' or WS_EX_TOOLWINDOW';\r
11350   end;\r
11351 \r
11352   //Log( '&4 TKOLForm.SetupFirst' );\r
11353 \r
11354   if helpContextIcon then\r
11355     S := S + ' or WS_EX_CONTEXTHELP';\r
11356   if S <> '' then\r
11357     SL.Add( Prefix + AName + '.ExStyle := ' + AName + '.ExStyle' + S + ';' );\r
11358 \r
11359   //Log( '&5 TKOLForm.SetupFirst' );\r
11360 \r
11361 {YS}\r
11362   {if helpContextIcon then\r
11363     SL.Add( Prefix + AName + '.ExStyle := ' + AName + '.ExStyle or WS_EX_CONTEXTHELP;' );}\r
11364   if not Visible then\r
11365     SL.Add( Prefix + AName + '.Visible := False;' );\r
11366   if not Enabled then\r
11367     SL.Add( Prefix + AName + '.Enabled := False;' );\r
11368   if DoubleBuffered and not Transparent then\r
11369     SL.Add( Prefix + AName + '.DoubleBuffered := True;' );\r
11370 {YS}\r
11371 \r
11372   //Log( '&6 TKOLForm.SetupFirst' );\r
11373 \r
11374   S := '';\r
11375   case FborderStyle of\r
11376     fbsDialog:\r
11377       S := S + ' and not (WS_MINIMIZEBOX or WS_MAXIMIZEBOX)';\r
11378     fbsToolWindow, fbsNone:\r
11379       ;\r
11380     else\r
11381       begin\r
11382         if not MinimizeIcon and not MaximizeIcon then\r
11383           S := S + ' and not (WS_MINIMIZEBOX or WS_MAXIMIZEBOX)'\r
11384         else\r
11385         begin\r
11386           if not MinimizeIcon then\r
11387             S := S + ' and not WS_MINIMIZEBOX';\r
11388           if not MaximizeIcon then\r
11389             S := S + ' and not WS_MAXIMIZEBOX';\r
11390         end;\r
11391       end;\r
11392   end;\r
11393 \r
11394   //Log( '&7 TKOLForm.SetupFirst' );\r
11395 \r
11396   if S <> '' then\r
11397     SL.Add( Prefix + AName + '.Style := ' + AName + '.Style' + S + ';' );\r
11398 \r
11399   //Log( '&8 TKOLForm.SetupFirst' );\r
11400 \r
11401 {YS}\r
11402   {if not MinimizeIcon and not MaximizeIcon then\r
11403     SL.Add( Prefix + AName + '.Style := ' + AName + '.Style and not (WS_MINIMIZEBOX or WS_MAXIMIZEBOX);' )\r
11404   else\r
11405   begin\r
11406     if not MinimizeIcon then\r
11407       SL.Add( Prefix + AName + '.Style := ' + AName + '.Style and not WS_MINIMIZEBOX;' );\r
11408     if not MaximizeIcon then\r
11409       SL.Add( Prefix + AName + '.Style := ' + AName + '.Style and not WS_MAXIMIZEBOX;' );\r
11410   end;}\r
11411   {if not CloseIcon then\r
11412     SL.Add( Prefix + AName + '.ClsStyle := ' + AName + '.ClsStyle or CS_NOCLOSE;' );}\r
11413 \r
11414   if Transparent then\r
11415     SL.Add( Prefix + AName + '.Transparent := True;' );\r
11416 \r
11417   //Log( '&9 TKOLForm.SetupFirst' );\r
11418 \r
11419   if (AlphaBlend <> 255) and (AlphaBlend > 0) then\r
11420     SL.Add( Prefix + AName + '.AlphaBlend := ' + IntToStr( AlphaBlend and $FF ) + ';' );\r
11421 \r
11422   //Log( '&010 TKOLForm.SetupFirst' );\r
11423 \r
11424   if not HasBorder then\r
11425     SL.Add( Prefix + AName + '.HasBorder := False;' );\r
11426 \r
11427   //Log( '&011 TKOLForm.SetupFirst' );\r
11428 \r
11429   if not HasCaption and HasBorder then\r
11430     SL.Add( Prefix + AName + '.HasCaption := False;' );\r
11431 \r
11432   //Log( '&012 TKOLForm.SetupFirst' );\r
11433 \r
11434   if StayOnTop then\r
11435     SL.Add( Prefix + AName + '.StayOnTop := True;' );\r
11436 \r
11437   //Log( '&013 TKOLForm.SetupFirst' );\r
11438 \r
11439   if not Ctl3D then\r
11440     SL.Add( Prefix + AName + '.Ctl3D := False;' );\r
11441 \r
11442   //Log( '&014 TKOLForm.SetupFirst' );\r
11443 \r
11444   if Icon <> '' then\r
11445   begin\r
11446     if Copy( Icon, 1, 1 ) = '#' then // +Alexander Pravdin\r
11447       SL.Add( Prefix + AName + '.IconLoad( hInstance, MAKEINTRESOURCE( ' +\r
11448         Copy( Icon, 2, Length( Icon ) - 1 ) + ' ) );' )\r
11449     else\r
11450     if Copy( Icon, 1, 4 ) = 'IDI_' then\r
11451       SL.Add( Prefix + AName + '.IconLoad( 0, ' + Icon + ' );' )\r
11452     else\r
11453     if Copy( Icon, 1, 4 ) = 'IDC_' then\r
11454       SL.Add( Prefix + AName + '.IconLoadCursor( 0, ' + Icon + ' );' )\r
11455     else\r
11456     if Icon = '-1' then\r
11457       SL.Add( Prefix + AName + '.Icon := THandle(-1);' )\r
11458     else\r
11459       SL.Add( Prefix + AName + '.IconLoad( hInstance, ''' + Icon + ''' );' );\r
11460   end;\r
11461 \r
11462   //Log( '&015 TKOLForm.SetupFirst' );\r
11463 \r
11464   if WindowState <> KOL.wsNormal then\r
11465     SL.Add( Prefix + AName + '.WindowState := ' + WindowStates[ WindowState ] +\r
11466             ';' );\r
11467 \r
11468   //Log( '&016 TKOLForm.SetupFirst' );\r
11469 \r
11470   if Trim( Cursor ) <> '' then\r
11471   begin\r
11472     if Copy( Cursor, 1, 4 ) = 'IDC_' then\r
11473       SL.Add( Prefix + AName + '.CursorLoad( 0, ' + Cursor + ' );' )\r
11474     else\r
11475       SL.Add( Prefix + AName + '.CursorLoad( hInstance, ''' + Trim( Cursor ) + ''' );' );\r
11476   end;\r
11477 \r
11478   //Log( '&017 TKOLForm.SetupFirst' );\r
11479 \r
11480   {if Color <> clBtnFace then\r
11481     SL.Add( Prefix + AName + '.Color := ' + Color2Str( Color ) + ' ;' );}\r
11482   if Brush <> nil then\r
11483     Brush.GenerateCode( SL, AName );\r
11484 \r
11485   //Log( '&018 TKOLForm.SetupFirst' );\r
11486 \r
11487   if (Font <> nil) AND not Font.Equal2( nil ) then\r
11488     Font.GenerateCode( SL, AName, nil );\r
11489 \r
11490   //Log( '&019 TKOLForm.SetupFirst' );\r
11491 \r
11492   if Border <> 2 then\r
11493     SL.Add( Prefix + AName + '.Border := ' + IntToStr( Border ) + ';' );\r
11494 \r
11495   //Log( '&020 TKOLForm.SetupFirst' );\r
11496 \r
11497   if MarginTop <> 0 then\r
11498     SL.Add( Prefix + AName + '.MarginTop := ' + IntToStr( MarginTop ) + ';' );\r
11499 \r
11500   //Log( '&021 TKOLForm.SetupFirst' );\r
11501 \r
11502   if MarginBottom <> 0 then\r
11503     SL.Add( Prefix + AName + '.MarginBottom := ' + IntToStr( MarginBottom ) + ';' );\r
11504 \r
11505   //Log( '&022 TKOLForm.SetupFirst' );\r
11506 \r
11507   if MarginLeft <> 0 then\r
11508     SL.Add( Prefix + AName + '.MarginLeft := ' + IntToStr( MarginLeft ) + ';' );\r
11509 \r
11510   //Log( '&023 TKOLForm.SetupFirst' );\r
11511 \r
11512   if MarginRight <> 0 then\r
11513     SL.Add( Prefix + AName + '.MarginRight := ' + IntToStr( MarginRight ) + ';' );\r
11514 \r
11515   //Log( '&024 TKOLForm.SetupFirst' );\r
11516 \r
11517   if (FStatusText <> nil) and (FStatusText.Text <> '') then\r
11518   begin\r
11519     if FStatusText.Count = 1 then\r
11520       SL.Add( Prefix + AName + '.SimpleStatusText := ' + PCharStringConstant( Self, 'SimpleStatusText', FStatusText[ 0 ] ) + ';' )\r
11521     else\r
11522     begin\r
11523       for I := 0 to FStatusText.Count-1 do\r
11524         SL.Add( Prefix + AName + '.StatusText[ ' + IntToStr( I ) + ' ] := ' +\r
11525                 PCharStringConstant( Self, 'StatusText' + IntToStr( I ), FStatusText[ I ] ) + ';' );\r
11526     end;\r
11527   end;\r
11528 \r
11529   //Log( '&025 TKOLForm.SetupFirst' );\r
11530 \r
11531   if not CloseIcon then\r
11532   begin\r
11533     SL.Add( Prefix + 'DeleteMenu( GetSystemMenu( Result.Form.GetWindowHandle, ' +\r
11534             'False ), SC_CLOSE, MF_BYCOMMAND );' );\r
11535   end;\r
11536 \r
11537   //Log( '&026 TKOLForm.SetupFirst' );\r
11538 \r
11539   AssignEvents( SL, AName );\r
11540 \r
11541   //Log( '&027 TKOLForm.SetupFirst' );\r
11542 \r
11543   if EraseBackground then\r
11544     SL.Add( Prefix + AName + '.EraseBackground := TRUE;' );\r
11545 \r
11546   //Log( '&028 TKOLForm.SetupFirst' );\r
11547 \r
11548   if MinWidth > 0 then\r
11549     SL.Add( Prefix + AName + '.MinWidth := ' + IntToStr( MinWidth ) + ';' );\r
11550 \r
11551   //Log( '&029 TKOLForm.SetupFirst' );\r
11552 \r
11553   if MinHeight > 0 then\r
11554     SL.Add( Prefix + AName + '.MinHeight := ' + IntToStr( MinHeight ) + ';' );\r
11555 \r
11556   //Log( '&030 TKOLForm.SetupFirst' );\r
11557 \r
11558   if MaxWidth > 0 then\r
11559     SL.Add( Prefix + AName + '.MaxWidth := ' + IntToStr( MaxWidth ) + ';' );\r
11560 \r
11561   //Log( '&031 TKOLForm.SetupFirst' );\r
11562 \r
11563   if MaxHeight > 0 then\r
11564     SL.Add( Prefix + AName + '.MaxHeight := ' + IntToStr( MaxHeight ) + ';' );\r
11565 \r
11566   //Log( '&032 TKOLForm.SetupFirst' );\r
11567 \r
11568   LogOK;\r
11569   finally\r
11570   Log( '<-TKOLForm.SetupFirst' );\r
11571   end;\r
11572 end;\r
11573 \r
11574 procedure TKOLForm.SetupLast(SL: TStringList; const AName,\r
11575   AParent, Prefix: String);\r
11576 var S: String;\r
11577 begin\r
11578   asm\r
11579     jmp @@e_signature\r
11580     DB '#$signature$#', 0\r
11581     DB 'TKOLForm.SetupLast', 0\r
11582   @@e_signature:\r
11583   end;\r
11584   Log( '->TKOLForm.SetupLast' );\r
11585   try\r
11586 \r
11587   if not FLocked then\r
11588   begin\r
11589     S := '';\r
11590     if CenterOnScreen then\r
11591       S := Prefix + AName + '.CenterOnParent';\r
11592     if not CanResize then\r
11593     begin\r
11594       if S = '' then\r
11595         S := Prefix + AName;\r
11596       S := S + '.CanResize := False';\r
11597     end;\r
11598     if S <> '' then\r
11599       SL.Add( S + ';' );\r
11600     if MinimizeNormalAnimated then\r
11601       SL.Add( Prefix + AName + '.MinimizeNormalAnimated;' );\r
11602     if Assigned( FpopupMenu ) then\r
11603       SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name +\r
11604               ' );' );\r
11605     if @ OnFormCreate <> nil then\r
11606     begin\r
11607       SL.Add( Prefix + 'Result.' + (Owner as TForm).MethodName( @ OnFormCreate ) + '( Result );' );\r
11608     end;\r
11609   {YS}\r
11610     if FborderStyle = fbsDialog then\r
11611       SL.Add( Prefix + AName + '.Icon := THandle(-1);' );\r
11612   {YS}\r
11613   end;\r
11614 \r
11615   LogOK;\r
11616   finally\r
11617   Log( '<-TKOLForm.SetupLast' );\r
11618   end;\r
11619 end;\r
11620 \r
11621 procedure TKOLForm.SetWindowState(const Value: KOL.TWindowState);\r
11622 begin\r
11623   asm\r
11624     jmp @@e_signature\r
11625     DB '#$signature$#', 0\r
11626     DB 'TKOLForm.SetWindowState', 0\r
11627   @@e_signature:\r
11628   end;\r
11629   Log( '->TKOLForm.SetWindowState' );\r
11630   try\r
11631 \r
11632   if not FLocked then\r
11633   begin\r
11634   FWindowState := Value;\r
11635   Change( Self );\r
11636   end;\r
11637 \r
11638   LogOK;\r
11639   finally\r
11640   Log( '<-TKOLForm.SetWindowState' );\r
11641   end;\r
11642 end;\r
11643 \r
11644 procedure TKOLForm.Set_Color(const Value: TColor);\r
11645 begin\r
11646   asm\r
11647     jmp @@e_signature\r
11648     DB '#$signature$#', 0\r
11649     DB 'TKOLForm.Set_Color', 0\r
11650   @@e_signature:\r
11651   end;\r
11652   Log( '->TKOLForm.Set_Color' );\r
11653   try\r
11654 \r
11655   if not FLocked then\r
11656   begin\r
11657     if Color <> Value then\r
11658     begin\r
11659     CollectChildrenWithParentColor;\r
11660     (Owner as TForm).Color := Value;\r
11661     FBrush.FColor := Value;\r
11662     ApplyColorToChildren;\r
11663     Change( Self );\r
11664     end;\r
11665   end;\r
11666 \r
11667   LogOK;\r
11668   finally\r
11669   Log( '<-TKOLForm.Set_Color' );\r
11670   end;\r
11671 end;\r
11672 \r
11673 procedure TKOLForm.ApplyFontToChildren;\r
11674 var I: Integer;\r
11675     C: TKOLCustomControl;\r
11676 begin\r
11677   asm\r
11678     jmp @@e_signature\r
11679     DB '#$signature$#', 0\r
11680     DB 'TKOLForm.ApplyFontToChildren', 0\r
11681   @@e_signature:\r
11682   end;\r
11683   Log( '->TKOLForm.ApplyFontToChildren' );\r
11684   try\r
11685 \r
11686   if not FLocked then\r
11687   begin\r
11688   for I := 0 to FParentLikeFontControls.Count - 1 do\r
11689   begin\r
11690     C := FParentLikeFontControls[ I ];\r
11691     //if C.parentFont then\r
11692       C.Font.Assign( Font );\r
11693   end;\r
11694   end;\r
11695 \r
11696   LogOK;\r
11697   finally\r
11698   Log( '<-TKOLForm.ApplyFontToChildren' );\r
11699   end;\r
11700 end;\r
11701 \r
11702 procedure TKOLForm.CollectChildrenWithParentFont;\r
11703 var ParentForm: TForm;\r
11704     I: Integer;\r
11705     C: TComponent;\r
11706 begin\r
11707   asm\r
11708     jmp @@e_signature\r
11709     DB '#$signature$#', 0\r
11710     DB 'TKOLForm.CollectChildrenWithParentFont', 0\r
11711   @@e_signature:\r
11712   end;\r
11713   Log( '->TKOLForm.CollectChildrenWithParentFont' );\r
11714   try\r
11715 \r
11716   if not (Owner is TForm) then\r
11717   begin\r
11718     LogOK;\r
11719     Exit;\r
11720   end;\r
11721   ParentForm := Owner as TForm;\r
11722   FParentLikeFontControls.Clear;\r
11723   for I := 0 to ParentForm.ComponentCount - 1 do\r
11724   begin\r
11725     C := ParentForm.Components[ I ];\r
11726     if (C is TKOLCustomControl) and ((C as TKOLCustomControl).Parent = ParentForm) then\r
11727     if (C as TKOLCustomControl).parentFont then\r
11728       FParentLikeFontControls.Add( C );\r
11729   end;\r
11730 \r
11731   LogOK;\r
11732   finally\r
11733   Log( '<-TKOLForm.CollectChildrenWithParentFont' );\r
11734   end;\r
11735 end;\r
11736 \r
11737 procedure TKOLForm.ApplyColorToChildren;\r
11738 var I: Integer;\r
11739     C: TKOLCustomControl;\r
11740 begin\r
11741   asm\r
11742     jmp @@e_signature\r
11743     DB '#$signature$#', 0\r
11744     DB 'TKOLForm.ApplyColorToChildren', 0\r
11745   @@e_signature:\r
11746   end;\r
11747   Log( '->TKOLForm.ApplyColorToChildren' );\r
11748   try\r
11749 \r
11750   if not FLocked then\r
11751   begin\r
11752     for I := 0 to FParentLikeColorControls.Count - 1 do\r
11753     begin\r
11754       C := FParentLikeColorControls[ I ];\r
11755       //if C.parentColor then\r
11756         C.Color := Color;\r
11757     end;\r
11758   end;\r
11759 \r
11760   LogOK;\r
11761   finally\r
11762   Log( '<-TKOLForm.ApplyColorToChildren' );\r
11763   end;\r
11764 end;\r
11765 \r
11766 procedure TKOLForm.CollectChildrenWithParentColor;\r
11767 var ParentForm: TForm;\r
11768     I: Integer;\r
11769     C: TComponent;\r
11770 begin\r
11771   asm\r
11772     jmp @@e_signature\r
11773     DB '#$signature$#', 0\r
11774     DB 'TKOLForm.CollectChildrenWithParentFont', 0\r
11775   @@e_signature:\r
11776   end;\r
11777   Log( '->TKOLForm.CollectChildrenWithParentColor' );\r
11778   try\r
11779 \r
11780   if not (Owner is TForm) then\r
11781   begin\r
11782     LogOK;\r
11783     Exit;\r
11784   end;\r
11785   ParentForm := Owner as TForm;\r
11786   FParentLikeColorControls.Clear;\r
11787   for I := 0 to ParentForm.ComponentCount - 1 do\r
11788   begin\r
11789     C := ParentForm.Components[ I ];\r
11790     if (C is TKOLCustomControl) and ((C as TKOLCustomControl).Parent = ParentForm) then\r
11791     if (C as TKOLCustomControl).parentColor then\r
11792       FParentLikeColorControls.Add( C );\r
11793   end;\r
11794 \r
11795   LogOK;\r
11796   finally\r
11797   Log( '<-TKOLForm.CollectChildrenWithParentColor' );\r
11798   end;\r
11799 end;\r
11800 \r
11801 function TKOLForm.NextUniqueID: Integer;\r
11802 begin\r
11803   asm\r
11804     jmp @@e_signature\r
11805     DB '#$signature$#', 0\r
11806     DB 'TKOLForm.NextUniqueID', 0\r
11807   @@e_signature:\r
11808   end;\r
11809   //Log( '->TKOLForm.NextUniqueID' );\r
11810   try\r
11811 \r
11812   Result := fUniqueID;\r
11813   Inc( fUniqueID );\r
11814 \r
11815   LogOK;\r
11816   finally\r
11817   //Log( '<-TKOLForm.NextUniqueID' );\r
11818   end;\r
11819 end;\r
11820 \r
11821 procedure TKOLForm.SetMinimizeNormalAnimated(const Value: Boolean);\r
11822 begin\r
11823   asm\r
11824     jmp @@e_signature\r
11825     DB '#$signature$#', 0\r
11826     DB 'TKOLForm.SetMinimizeNormalAnimated', 0\r
11827   @@e_signature:\r
11828   end;\r
11829   Log( '->TKOLForm.SetMinimizeNormalAnimated' );\r
11830   try\r
11831 \r
11832   if not FLocked then\r
11833   begin\r
11834   FMinimizeNormalAnimated := Value;\r
11835   Change( Self );\r
11836   end;\r
11837 \r
11838   LogOK;\r
11839   finally\r
11840   Log( '<-TKOLForm.SetMinimizeNormalAnimated' );\r
11841   end;\r
11842 end;\r
11843 \r
11844 procedure TKOLForm.SetLocked(const Value: Boolean);\r
11845 var I: Integer;\r
11846 begin\r
11847   asm\r
11848     jmp @@e_signature\r
11849     DB '#$signature$#', 0\r
11850     DB 'TKOLForm.SetLocked', 0\r
11851   @@e_signature:\r
11852   end;\r
11853   Log( '->TKOLForm.SetLocked' );\r
11854   try\r
11855 \r
11856   if FLocked = Value then\r
11857   begin\r
11858     LogOK;\r
11859     Exit;\r
11860   end;\r
11861   if not Value then\r
11862   begin\r
11863     for I := 0 to Owner.ComponentCount-1 do\r
11864       if IsVCLControl( Owner.Components[ I ] ) then\r
11865       begin\r
11866         ShowMessage( 'Form ' + Owner.Name + ' contains VCL controls. TKOLForm ' +\r
11867                      'component can not be unlocked.' );\r
11868         LogOK;\r
11869         Exit;\r
11870       end;\r
11871     I := MessageBox( 0, 'TKOLForm component was locked because the form had ' +\r
11872          'VCL controls placed on it. Are You sure You want to unlock TKOLForm?'#13 +\r
11873          '(Note: if the form is beloning to VCL-based project, unlocking TKOLForm ' +\r
11874          'component can damage the form).', 'CAUTION!', MB_YESNO or MB_SETFOREGROUND );\r
11875     if I = ID_NO then\r
11876     begin\r
11877       LogOK;\r
11878       Exit;\r
11879     end;\r
11880   end;\r
11881   FLocked := Value;\r
11882 \r
11883   LogOK;\r
11884   finally\r
11885   Log( '<-TKOLForm.SetLocked' );\r
11886   end;\r
11887 end;\r
11888 \r
11889 procedure TKOLForm.SetOnShow(const Value: TOnEvent);\r
11890 begin\r
11891   asm\r
11892     jmp @@e_signature\r
11893     DB '#$signature$#', 0\r
11894     DB 'TKOLForm.SetOnShow', 0\r
11895   @@e_signature:\r
11896   end;\r
11897   Log( '->TKOLForm.SetOnShow' );\r
11898   try\r
11899 \r
11900   FOnShow := Value;\r
11901   Change( Self );\r
11902 \r
11903   LogOK;\r
11904   finally\r
11905   Log( '<-TKOLForm.SetOnShow' );\r
11906   end;\r
11907 end;\r
11908 \r
11909 procedure TKOLForm.SetOnHide(const Value: TOnEvent);\r
11910 begin\r
11911   asm\r
11912     jmp @@e_signature\r
11913     DB '#$signature$#', 0\r
11914     DB 'TKOLForm.SetOnHide', 0\r
11915   @@e_signature:\r
11916   end;\r
11917   Log( '->TKOLForm.SetOnHide' );\r
11918   try\r
11919   FOnHide := Value;\r
11920   Change( Self );\r
11921   LogOK;\r
11922   finally\r
11923   Log( '<-TKOLForm.SetOnHide' );\r
11924   end;\r
11925 end;\r
11926 \r
11927 procedure TKOLForm.SetzOrderChildren(const Value: Boolean);\r
11928 begin\r
11929   asm\r
11930     jmp @@e_signature\r
11931     DB '#$signature$#', 0\r
11932     DB 'TKOLForm.SetzOrderChildren', 0\r
11933   @@e_signature:\r
11934   end;\r
11935   Log( '->TKOLForm.SetzOrderChildren' );\r
11936   try\r
11937   FzOrderChildren := Value;\r
11938   Change( Self );\r
11939   LogOK;\r
11940   finally\r
11941   Log( '<-TKOLForm.SetzOrderChildren' );\r
11942   end;\r
11943 end;\r
11944 \r
11945 procedure TKOLForm.SetSimpleStatusText(const Value: String);\r
11946 begin\r
11947   asm\r
11948     jmp @@e_signature\r
11949     DB '#$signature$#', 0\r
11950     DB 'TKOLForm.SetSimpleStatusText', 0\r
11951   @@e_signature:\r
11952   end;\r
11953   Log( '->TKOLForm.SetSimpleStatusText' );\r
11954   try\r
11955   FSimpleStatusText := Value;\r
11956   FStatusText.Text := Value;\r
11957   Change( Self );\r
11958   LogOK;\r
11959   finally\r
11960   Log( '<-TKOLForm.SetSimpleStatusText' );\r
11961   end;\r
11962 end;\r
11963 \r
11964 function TKOLForm.GetStatusText: TStrings;\r
11965 begin\r
11966   asm\r
11967     jmp @@e_signature\r
11968     DB '#$signature$#', 0\r
11969     DB 'TKOLForm.GetStatusText', 0\r
11970   @@e_signature:\r
11971   end;\r
11972   Result := FStatusText;\r
11973 end;\r
11974 \r
11975 procedure TKOLForm.SetStatusText(const Value: TStrings);\r
11976 begin\r
11977   asm\r
11978     jmp @@e_signature\r
11979     DB '#$signature$#', 0\r
11980     DB 'TKOLForm.SetStatusText', 0\r
11981   @@e_signature:\r
11982   end;\r
11983   Log( '->TKOLForm.SetStatusText' );\r
11984   try\r
11985   if Value = nil then\r
11986     FStatusText.Text := ''\r
11987   else\r
11988     FStatusText.Text := Value.Text;\r
11989   if FStatusText.Count = 1 then\r
11990     FSimpleStatusText := FStatusText.Text\r
11991   else\r
11992     FSimpleStatusText := '';\r
11993   Change( Self );\r
11994   LogOK;\r
11995   finally\r
11996   Log( '<-TKOLForm.SetStatusText' );\r
11997   end;\r
11998 end;\r
11999 \r
12000 procedure TKOLForm.SetOnMouseDblClk(const Value: TOnMouse);\r
12001 begin\r
12002   asm\r
12003     jmp @@e_signature\r
12004     DB '#$signature$#', 0\r
12005     DB 'TKOLForm.SetOnMouseDblClk', 0\r
12006   @@e_signature:\r
12007   end;\r
12008   Log( '->TKOLForm.SetOnMouseDblClk' );\r
12009   try\r
12010   fOnMouseDblClk := Value;\r
12011   Change( Self );\r
12012   LogOK;\r
12013   finally\r
12014   Log( '<-TKOLForm.SetOnMouseDblClk' );\r
12015   end;\r
12016 end;\r
12017 \r
12018 procedure TKOLForm.GenerateCreateForm(SL: TStringList);\r
12019 var S: String;\r
12020 begin\r
12021   asm\r
12022     jmp @@e_signature\r
12023     DB '#$signature$#', 0\r
12024     DB 'TKOLForm.GenerateCreateForm', 0\r
12025   @@e_signature:\r
12026   end;\r
12027   Log( '->TKOLForm.GenerateCreateForm' );\r
12028   try\r
12029 \r
12030   S := GenerateTransparentInits;\r
12031 \r
12032   SL.Add( '  Result.Form := NewForm( AParent, ' + StringConstant( 'Caption', Caption ) +\r
12033           ' )' + S + ';' );\r
12034   if @ OnBeforeCreateWindow <> nil then\r
12035     SL.Add( '      Result.' +\r
12036           (Owner as TForm).MethodName( @ OnBeforeCreateWindow ) + '( Result );' );\r
12037   // Åñëè ôîðìà ãëàâíàÿ, è Applet íå èñïîëüçóåòñÿ, èíèöèàëèçèðîâàòü çäåñü\r
12038   // ïåðåìåííóþ Applet:\r
12039   if FormMain and not AppletOnForm then\r
12040     SL.Add( '  Applet :=  Result.Form;' );\r
12041 \r
12042   LogOK;\r
12043   finally\r
12044   Log( '<-TKOLForm.GenerateCreateForm' );\r
12045   end;\r
12046 end;\r
12047 \r
12048 function TKOLForm.Result_Form: String;\r
12049 begin\r
12050   asm\r
12051     jmp @@e_signature\r
12052     DB '#$signature$#', 0\r
12053     DB 'TKOLForm.Result_Form', 0\r
12054   @@e_signature:\r
12055   end;\r
12056   Result := 'Result.Form';\r
12057 end;\r
12058 \r
12059 procedure TKOLForm.GenerateDestroyAfterRun(SL: TStringList);\r
12060 begin\r
12061   asm\r
12062     jmp @@e_signature\r
12063     DB '#$signature$#', 0\r
12064     DB 'TKOLForm.GenerateDestroyAfterRun', 0\r
12065   @@e_signature:\r
12066   end;\r
12067   // nothing\r
12068 end;\r
12069 \r
12070 procedure TKOLForm.SetMarginBottom(const Value: Integer);\r
12071 begin\r
12072   asm\r
12073     jmp @@e_signature\r
12074     DB '#$signature$#', 0\r
12075     DB 'TKOLForm.SetMarginBottom', 0\r
12076   @@e_signature:\r
12077   end;\r
12078   Log( '->TKOLForm.SetMarginBottom' );\r
12079   try\r
12080 \r
12081   if FMarginBottom = Value then\r
12082   begin\r
12083     LogOK;\r
12084     Exit;\r
12085   end;\r
12086   FMarginBottom := Value;\r
12087   AlignChildren( nil, FALSE );\r
12088   Change( Self );\r
12089 \r
12090   LogOK;\r
12091   finally\r
12092   Log( '<-TKOLForm.SetMarginBottom' );\r
12093   end;\r
12094 end;\r
12095 \r
12096 procedure TKOLForm.SetMarginLeft(const Value: Integer);\r
12097 begin\r
12098   asm\r
12099     jmp @@e_signature\r
12100     DB '#$signature$#', 0\r
12101     DB 'TKOLForm.SetMarginLeft', 0\r
12102   @@e_signature:\r
12103   end;\r
12104   Log( '->TKOLForm.SetMarginLeft' );\r
12105   try\r
12106 \r
12107   if FMarginLeft = Value then\r
12108   begin\r
12109     LogOK;\r
12110     Exit;\r
12111   end;\r
12112   FMarginLeft := Value;\r
12113   AlignChildren( nil, FALSE );\r
12114   Change( Self );\r
12115 \r
12116   LogOK;\r
12117   finally\r
12118   Log( '<-TKOLForm.SetMarginLeft' );\r
12119   end;\r
12120 end;\r
12121 \r
12122 procedure TKOLForm.SetMarginRight(const Value: Integer);\r
12123 begin\r
12124   asm\r
12125     jmp @@e_signature\r
12126     DB '#$signature$#', 0\r
12127     DB 'TKOLForm.SetMarginRight', 0\r
12128   @@e_signature:\r
12129   end;\r
12130   Log( '->TKOLForm.SetMarginRight' );\r
12131   try\r
12132 \r
12133   if FMarginRight = Value then\r
12134   begin\r
12135     LogOK;\r
12136     Exit;\r
12137   end;\r
12138   FMarginRight := Value;\r
12139   AlignChildren( nil, FALSE );\r
12140   Change( Self );\r
12141 \r
12142   LogOK;\r
12143   finally\r
12144   Log( '<-TKOLForm.SetMarginRight' );\r
12145   end;\r
12146 end;\r
12147 \r
12148 procedure TKOLForm.SetMarginTop(const Value: Integer);\r
12149 begin\r
12150   asm\r
12151     jmp @@e_signature\r
12152     DB '#$signature$#', 0\r
12153     DB 'TKOLForm.SetMarginTop', 0\r
12154   @@e_signature:\r
12155   end;\r
12156   Log( '->TKOLForm.SetMarginTop' );\r
12157   try\r
12158 \r
12159   if FMarginTop = Value then\r
12160   begin\r
12161     LogOK;\r
12162     Exit;\r
12163   end;\r
12164   FMarginTop := Value;\r
12165   AlignChildren( nil, FALSE );\r
12166   Change( Self );\r
12167 \r
12168   LogOK;\r
12169   finally\r
12170   Log( '<-TKOLForm.SetMarginTop' );\r
12171   end;\r
12172 end;\r
12173 \r
12174 procedure TKOLForm.SetOnEraseBkgnd(const Value: TOnPaint);\r
12175 begin\r
12176   asm\r
12177     jmp @@e_signature\r
12178     DB '#$signature$#', 0\r
12179     DB 'TKOLForm.SetOnEraseBkgnd', 0\r
12180   @@e_signature:\r
12181   end;\r
12182   Log( '->TKOLForm.SetOnEraseBkgnd' );\r
12183   try\r
12184 \r
12185   FOnEraseBkgnd := Value;\r
12186   Change( Self );\r
12187 \r
12188   LogOK;\r
12189   finally\r
12190   Log( '<-TKOLForm.SetOnEraseBkgnd' );\r
12191   end;\r
12192 end;\r
12193 \r
12194 procedure TKOLForm.SetOnPaint(const Value: TOnPaint);\r
12195 begin\r
12196   asm\r
12197     jmp @@e_signature\r
12198     DB '#$signature$#', 0\r
12199     DB 'TKOLForm.SetOnPaint', 0\r
12200   @@e_signature:\r
12201   end;\r
12202   Log( '->TKOLForm.SetOnPaint' );\r
12203   try\r
12204   FOnPaint := Value;\r
12205   Change( Self );\r
12206   LogOK;\r
12207   finally\r
12208   Log( '<-TKOLForm.SetOnPaint' );\r
12209   end;\r
12210 end;\r
12211 \r
12212 procedure TKOLForm.SetEraseBackground(const Value: Boolean);\r
12213 begin\r
12214   asm\r
12215     jmp @@e_signature\r
12216     DB '#$signature$#', 0\r
12217     DB 'TKOLForm.SetEraseBackground', 0\r
12218   @@e_signature:\r
12219   end;\r
12220   Log( '->TKOLForm.SetEraseBackground' );\r
12221   try\r
12222   FEraseBackground := Value;\r
12223   Change( Self );\r
12224   LogOK;\r
12225   finally\r
12226   Log( '<-TKOLForm.SetEraseBackground' );\r
12227   end;\r
12228 end;\r
12229 \r
12230 procedure TKOLForm.GenerateAdd2AutoFree(SL: TStringList;\r
12231   const AName: String; AControl: Boolean; Add2AutoFreeProc: String; Obj: TObject);\r
12232 begin\r
12233   asm\r
12234     jmp @@e_signature\r
12235     DB '#$signature$#', 0\r
12236     DB 'TKOLForm.GenerateAdd2AutoFree', 0\r
12237   @@e_signature:\r
12238   end;\r
12239   Log( '->TKOLForm.GenerateAdd2AutoFree' );\r
12240   try\r
12241 \r
12242   if Obj <> nil then\r
12243   if Obj is TKOLObj then\r
12244   if (Obj as TKOLObj).NotAutoFree then\r
12245   begin\r
12246     LogOK;\r
12247     Exit;\r
12248   end;\r
12249   if Add2AutoFreeProc = '' then\r
12250     Add2AutoFreeProc := 'Add2AutoFree';\r
12251   if not AControl then\r
12252     SL.Add( '  Result.Form.' + Add2AutoFreeProc + '( ' + AName + ' );' );\r
12253 \r
12254   LogOK;\r
12255   finally\r
12256   Log( '<-TKOLForm.GenerateAdd2AutoFree' );\r
12257   end;\r
12258 end;\r
12259 \r
12260 function TKOLForm.AdditionalUnits: String;\r
12261 var I: Integer;\r
12262     C: TComponent;\r
12263     S: String;\r
12264 begin\r
12265   asm\r
12266     jmp @@e_signature\r
12267     DB '#$signature$#', 0\r
12268     DB 'TKOLForm.AdditionalUnits', 0\r
12269   @@e_signature:\r
12270   end;\r
12271   Log( '->TKOLForm.AdditionalUnits' );\r
12272   try\r
12273 \r
12274   Result := '';\r
12275   for I := 0 to (Owner as TForm).ComponentCount-1 do\r
12276   begin\r
12277     C := (Owner as TForm).Components[ I ];\r
12278     S := '';\r
12279     if C is TKOLCustomControl then\r
12280       S := (C as TKOLCustomControl).AdditionalUnits\r
12281     else\r
12282     if C is TKOLObj then\r
12283       S := (C as TKOLObj).AdditionalUnits;\r
12284     if S <> '' then\r
12285       if pos(S, Result) = 0 then\r
12286       begin\r
12287         {if Result <> '' then\r
12288           Result := Result + ', ';}\r
12289         Result := Result + S;\r
12290       end;\r
12291   end;\r
12292 \r
12293   LogOK;\r
12294   finally\r
12295   Log( '<-TKOLForm.AdditionalUnits' );\r
12296   end;\r
12297 end;\r
12298 \r
12299 function TKOLForm.FormTypeName: String;\r
12300 begin\r
12301   asm\r
12302     jmp @@e_signature\r
12303     DB '#$signature$#', 0\r
12304     DB 'TKOLForm.FormTypeName', 0\r
12305   @@e_signature:\r
12306   end;\r
12307   Result := 'PControl';\r
12308 end;\r
12309 \r
12310 procedure TKOLForm.AfterGeneratePas(SL: TStringList);\r
12311 var s0, s: String;\r
12312     NomPrivate, NomC: Integer;\r
12313     I: Integer;\r
12314     C: TComponent;\r
12315 begin\r
12316   asm\r
12317     jmp @@e_signature\r
12318     DB '#$signature$#', 0\r
12319     DB 'TKOLForm.AfterGeneratePas', 0\r
12320   @@e_signature:\r
12321   end;\r
12322   Log( '->TKOLForm.AfterGeneratePas' );\r
12323   try\r
12324 \r
12325   // to change generated Pas after GeneratePas procedure - in descendants.\r
12326   //-------------------- added by Alexander Rabotyagov:\r
12327   s0:='private{$ENDIF} {<-- It is a VCL control}';\r
12328     s:='';\r
12329   repeat\r
12330     NomPrivate:=SL.IndexOf(s+s0);\r
12331   s:=s+' ';\r
12332   until not((NomPrivate<0)and(length(s)<15));\r
12333   if NomPrivate>=0 then SL[NomPrivate]:='  private';\r
12334 \r
12335   if not FLocked then\r
12336   for I := 0 to Owner.ComponentCount - 1 do\r
12337   begin\r
12338     C := Owner.Components[ I ];\r
12339     if C = Self then Continue;\r
12340     if (C is controls.TControl)and(not((C is TKOLApplet) or (C is TKOLCustomControl) or (C is TOleControl)))and(c.tag=cKolTag)\r
12341     then begin\r
12342 \r
12343        s0:=c.Name+': '+c.ClassName+';';\r
12344        s:='';\r
12345        repeat\r
12346          NomC:=SL.IndexOf(s+s0);\r
12347          s:=s+' ';\r
12348        until not((NomC<0)and(length(s)<15));\r
12349 \r
12350        s0:='private';\r
12351        s:='';\r
12352        repeat\r
12353          NomPrivate:=SL.IndexOf(s+s0);\r
12354          s:=s+' ';\r
12355        until not((NomPrivate<0)and(length(s)<15));\r
12356 \r
12357        if (NomC>=0)and(NomPrivate>=0)\r
12358        then begin\r
12359          SL.Insert(NomPrivate+1,'    {$IFNDEF KOL_MCK}'+c.Name+': '+c.ClassName+';{$ENDIF} {<-- It is a VCL control}');\r
12360          SL.Delete(NomC);\r
12361        end;\r
12362 \r
12363     end;\r
12364   end;//i\r
12365 \r
12366   LogOK;\r
12367   finally\r
12368   Log( '<-TKOLForm.AfterGeneratePas' );\r
12369   end;\r
12370 end;\r
12371 \r
12372 procedure TKOLForm.SetOnMove(const Value: TOnEvent);\r
12373 begin\r
12374   asm\r
12375     jmp @@e_signature\r
12376     DB '#$signature$#', 0\r
12377     DB 'TKOLForm.SetOnMove', 0\r
12378   @@e_signature:\r
12379   end;\r
12380   Log( '->TKOLForm.SetOnMove' );\r
12381   try\r
12382   FOnMove := Value;\r
12383   Change( Self );\r
12384   LogOK;\r
12385   finally\r
12386   Log( '<-TKOLForm.SetOnMove' );\r
12387   end;\r
12388 end;\r
12389 \r
12390 procedure TKOLForm.SetSupportMnemonics(const Value: Boolean);\r
12391 begin\r
12392   asm\r
12393     jmp @@e_signature\r
12394     DB '#$signature$#', 0\r
12395     DB 'TKOLForm.SetSupportMnemonics', 0\r
12396   @@e_signature:\r
12397   end;\r
12398   Log( '->TKOLForm.SetSupportAnsiMnemonics' );\r
12399   try\r
12400   FSupportMnemonics := Value;\r
12401   Change( Self );\r
12402   LogOK;\r
12403   finally\r
12404   Log( '<-TKOLForm.SetSupportAnsiMnemonics' );\r
12405   end;\r
12406 end;\r
12407 \r
12408 procedure TKOLForm.SetStatusSizeGrip(const Value: Boolean);\r
12409 begin\r
12410   asm\r
12411     jmp @@e_signature\r
12412     DB '#$signature$#', 0\r
12413     DB 'TKOLForm.SetStatusSizeGrip', 0\r
12414   @@e_signature:\r
12415   end;\r
12416   Log( '->TKOLForm.SetStatusSizeGrip' );\r
12417   try\r
12418   FStatusSizeGrip := Value;\r
12419   Change( Self );\r
12420   LogOK;\r
12421   finally\r
12422   Log( '<-TKOLForm.SetStatusSizeGrip' );\r
12423   end;\r
12424 end;\r
12425 \r
12426 procedure TKOLForm.SetPaintType(const Value: TPaintType);\r
12427 begin\r
12428   asm\r
12429     jmp @@e_signature\r
12430     DB '#$signature$#', 0\r
12431     DB 'TKOLForm.SetPaintType', 0\r
12432   @@e_signature:\r
12433   end;\r
12434   Log( '->TKOLForm.SetPaintType' );\r
12435   try\r
12436   if FPaintType = Value then\r
12437   begin\r
12438     LogOK;\r
12439     Exit;\r
12440   end;\r
12441   {ShowMessage( 'Painttype=' + IntToStr( Integer( Value ) ) + ', OldPaintType=' +\r
12442                IntToStr( Integer( FPaintType ) ) );}\r
12443   FPaintType := Value;\r
12444   InvalidateControls;\r
12445   LogOK;\r
12446   finally\r
12447   Log( '<-TKOLForm.SetPaintType' );\r
12448   end;\r
12449 end;\r
12450 \r
12451 procedure TKOLForm.InvalidateControls;\r
12452 var I: Integer;\r
12453     C: TComponent;\r
12454 begin\r
12455   asm\r
12456     jmp @@e_signature\r
12457     DB '#$signature$#', 0\r
12458     DB 'TKOLForm.InvalidateControls', 0\r
12459   @@e_signature:\r
12460   end;\r
12461   Log( '->TKOLForm.InvalidateControls' );\r
12462   try\r
12463 \r
12464   if Owner = nil then\r
12465   begin\r
12466     LogOK;\r
12467     Exit;\r
12468   end;\r
12469   if not( Owner is TForm ) then\r
12470   begin\r
12471     LogOK;\r
12472     Exit;\r
12473   end;\r
12474   for I := 0 to (Owner as TForm).ComponentCount - 1 do\r
12475   begin\r
12476     C := (Owner as TForm).Components[ I ];\r
12477     if C is TKOLCustomControl then\r
12478 {YS}\r
12479       with  C as TKOLCustomControl do begin\r
12480   {$IFDEF _KOLCtrlWrapper_}\r
12481         AllowSelfPaint := PaintType in [ptWYSIWIG, ptWYSIWIGFrames];\r
12482         AllowCustomPaint := PaintType <> ptWYSIWIG;  {<<<<<<<}\r
12483   {$ENDIF}\r
12484         Invalidate;\r
12485       end;\r
12486 {YS}\r
12487   end;\r
12488   (Owner as TForm).Invalidate;\r
12489 \r
12490   LogOK;\r
12491   finally\r
12492   Log( '<-TKOLForm.InvalidateControls' );\r
12493   end;\r
12494 end;\r
12495 \r
12496 procedure TKOLForm.Loaded;\r
12497 begin\r
12498   asm\r
12499     jmp @@e_signature\r
12500     DB '#$signature$#', 0\r
12501     DB 'TKOLForm.Loaded', 0\r
12502   @@e_signature:\r
12503   end;\r
12504   Log( '->TKOLForm.Loaded' );\r
12505   try\r
12506 \r
12507   inherited;\r
12508   GetPaintTypeFromProjectOrOtherForms;\r
12509   Font.Change;\r
12510   FChangeTimer.Enabled := FALSE;\r
12511   FChangeTimer.Enabled := TRUE;\r
12512   bounds.EnableTimer( TRUE );\r
12513 \r
12514   LogOK;\r
12515   finally\r
12516   Log( '<-TKOLForm.Loaded' );\r
12517   end;\r
12518 end;\r
12519 \r
12520 procedure TKOLForm.GetPaintTypeFromProjectOrOtherForms;\r
12521 var I, J: Integer;\r
12522     F: TForm;\r
12523     C: TComponent;\r
12524     NewPaintType: TPaintType;\r
12525 begin\r
12526   asm\r
12527     jmp @@e_signature\r
12528     DB '#$signature$#', 0\r
12529     DB 'TKOLForm.GetPaintTypeFromProjectOrOtherForms', 0\r
12530   @@e_signature:\r
12531   end;\r
12532   Log( '->TKOLForm.GetPaintTypeFromProjectOrOtherForms' );\r
12533   try\r
12534 \r
12535   NewPaintType := PaintType;\r
12536   if Screen = nil then\r
12537   begin\r
12538     LogOK;\r
12539     Exit;\r
12540   end;\r
12541   for I := 0 to Screen.FormCount-1 do\r
12542   begin\r
12543     F := Screen.Forms[ I ];\r
12544     for J := 0 to F.ComponentCount-1 do\r
12545     begin\r
12546       C := F.Components[ J ];\r
12547       if C is TKOLProject then\r
12548       begin\r
12549         NewPaintType := (C as TKOLProject).PaintType;\r
12550         break;\r
12551       end;\r
12552       if C is TKOLForm then\r
12553       if C <> Self then\r
12554         NewPaintType := (C as TKOLForm).PaintType;\r
12555     end;\r
12556   end;\r
12557   PaintType := NewPaintType;\r
12558 \r
12559   LogOK;\r
12560   finally\r
12561   Log( '<-TKOLForm.GetPaintTypeFromProjectOrOtherForms' );\r
12562   end;\r
12563 end;\r
12564 \r
12565 function SortControls( Item1, Item2: Pointer ): Integer;\r
12566 var K1, K2: TKOLCustomControl;\r
12567 begin\r
12568   asm\r
12569     jmp @@e_signature\r
12570     DB '#$signature$#', 0\r
12571     DB 'SortControls', 0\r
12572   @@e_signature:\r
12573   end;\r
12574   K1 := Item1;\r
12575   K2 := Item2;\r
12576   Result := CmpInts( K1.TabOrder, K2.TabOrder );\r
12577   if (Result = 0) and (K1.Align = K2.Align) then\r
12578   begin\r
12579     case K1.Align of\r
12580     caTop: Result := CmpInts( K1.Top, K2.Top );\r
12581     caBottom: Result := CmpInts( K2.Top, K1.Top );\r
12582     caLeft: Result := CmpInts( K1.Left, K2.Left );\r
12583     caRight: Result := CmpInts( K2.Left, K1.Left );\r
12584     else\r
12585       Result := 0;\r
12586     end;\r
12587   end;\r
12588 end;\r
12589 \r
12590 procedure TKOLForm.AlignChildren(PrntCtrl: TKOLCustomControl; Recursive: Boolean);\r
12591 type\r
12592   TAligns = set of TKOLAlign;\r
12593 var Controls: TList;\r
12594     I: Integer;\r
12595     P: TComponent;\r
12596     CR, CM: TRect;\r
12597     PrntBorder: Integer;\r
12598   procedure DoAlign( Allowed: TAligns );\r
12599   var I: Integer;\r
12600       C: TKOLCustomControl;\r
12601       R, R1: TRect;\r
12602       W, H: Integer;\r
12603       ChgPos, ChgSiz: Boolean;\r
12604   begin\r
12605   asm\r
12606     jmp @@e_signature\r
12607     DB '#$signature$#', 0\r
12608     DB 'TKOLForm.AlignChildren.DoAlign', 0\r
12609   @@e_signature:\r
12610   end;\r
12611     for I := 0 to Controls.Count - 1 do\r
12612     begin\r
12613       C := Controls[ I ];\r
12614       //if not C.ToBeVisible then continue;\r
12615       // important: not fVisible, and even not Visible, but ToBeVisible!\r
12616       //if C.UseAlign then continue;\r
12617       if C.Align in Allowed then\r
12618       begin\r
12619         R := C.BoundsRect;\r
12620         R1 := R;\r
12621         W := R.Right - R.Left;\r
12622         H := R.Bottom - R.Top;\r
12623         case C.Align of\r
12624         caTop:\r
12625           begin\r
12626             OffsetRect( R, 0, -R.Top + CR.Top + PrntBorder );\r
12627             Inc( CR.Top, H + PrntBorder );\r
12628             R.Left := CR.Left + PrntBorder;\r
12629             R.Right := CR.Right - PrntBorder;\r
12630           end;\r
12631         caBottom:\r
12632           begin\r
12633             OffsetRect( R, 0, -R.Bottom + CR.Bottom - PrntBorder );\r
12634             Dec( CR.Bottom, H + PrntBorder );\r
12635             R.Left := CR.Left + PrntBorder;\r
12636             R.Right := CR.Right - PrntBorder;\r
12637           end;\r
12638         caLeft:\r
12639           begin\r
12640             OffsetRect( R, -R.Left + CR.Left + PrntBorder, 0 );\r
12641             Inc( CR.Left, W + PrntBorder );\r
12642             R.Top := CR.Top + PrntBorder;\r
12643             R.Bottom := CR.Bottom - PrntBorder;\r
12644           end;\r
12645         caRight:\r
12646           begin\r
12647             OffsetRect( R, -R.Right + CR.Right - PrntBorder, 0 );\r
12648             Dec( CR.Right, W + PrntBorder );\r
12649             R.Top := CR.Top + PrntBorder;\r
12650             R.Bottom := CR.Bottom - PrntBorder;\r
12651           end;\r
12652         caClient:\r
12653           begin\r
12654             R := CR;\r
12655             InflateRect( R, -PrntBorder, -PrntBorder );\r
12656           end;\r
12657         end;\r
12658         if R.Right < R.Left then R.Right := R.Left;\r
12659         if R.Bottom < R.Top then R.Bottom := R.Top;\r
12660         ChgPos := (R.Left <> R1.Left) or (R.Top <> R1.Top);\r
12661         ChgSiz := (R.Right - R.Left <> W) or (R.Bottom - R.Top <> H);\r
12662         if ChgPos or ChgSiz then\r
12663         begin\r
12664           C.BoundsRect := R;\r
12665           {if ChgSiz then\r
12666             AlignChildrenProc( C );}\r
12667         end;\r
12668       end;\r
12669     end;\r
12670   end;\r
12671 begin\r
12672   asm\r
12673     jmp @@e_signature\r
12674     DB '#$signature$#', 0\r
12675     DB 'TKOLForm.AlignChildren', 0\r
12676   @@e_signature:\r
12677   end;\r
12678   Log( '->TKOLForm.AlignChildren' );\r
12679   try\r
12680 \r
12681   if csLoading in ComponentState then\r
12682   begin\r
12683     LogOK;\r
12684     Exit;\r
12685   end;\r
12686   if not AllowRealign then\r
12687   begin\r
12688     LogOK;\r
12689     Exit;\r
12690   end;\r
12691   Controls := TList.Create;\r
12692   if PrntCtrl = nil then\r
12693     AllowRealign := FALSE;\r
12694   Inc( FRealigning );\r
12695   TRY\r
12696     //-- collect controls, which are children of PrntCtrl\r
12697     for I := 0 to (Owner as TForm).ComponentCount-1 do\r
12698     begin\r
12699       if (Owner as TForm).Components[ I ] is TKOLCustomControl then\r
12700       begin\r
12701         P := ((Owner as TForm).Components[ I ] as TKOLCustomControl).Parent;\r
12702         if (P = PrntCtrl) or (PrntCtrl = nil) and (P is TForm) then\r
12703           Controls.Add( (Owner as TForm).Components[ I ] );\r
12704       end;\r
12705     end;\r
12706     //-- order controls by TabOrder\r
12707     Controls.Sort( SortControls );\r
12708     //-- initialize client rectangle\r
12709     if PrntCtrl = nil then\r
12710     begin\r
12711       CR := //Rect( 0, 0, bounds.Width, bounds.Height );\r
12712            (Owner as TForm).ClientRect;\r
12713       CR.Left := CR.Left + MarginLeft;\r
12714       CR.Top  := CR.Top + MarginTop;\r
12715       CR.Right := CR.Right - MarginRight;\r
12716       CR.Bottom := CR.Bottom - MarginBottom;\r
12717       PrntBorder := Border;\r
12718     end\r
12719       else\r
12720     begin\r
12721       CR := PrntCtrl.ClientRect;\r
12722       CM := PrntCtrl.ClientMargins;\r
12723       CR.Left := CR.Left + PrntCtrl.MarginLeft + CM.Left;\r
12724       CR.Top := CR.Top + PrntCtrl.MarginTop + CM.Top;\r
12725       CR.Right := CR.Right - PrntCtrl.MarginRight - CM.Right;\r
12726       CR.Bottom := CR.Bottom - PrntCtrl.MarginBottom - CM.Bottom;\r
12727       PrntBorder := PrntCtrl.Border;\r
12728     end;\r
12729     DoAlign( [ caTop, caBottom ] );\r
12730     DoAlign( [ caLeft, caRight ] );\r
12731     DoAlign( [ caClient ] );\r
12732     if PrntCtrl = nil then\r
12733       AllowRealign := TRUE;\r
12734     if Recursive then\r
12735       for I := 0 to Controls.Count-1 do\r
12736         AlignChildren( TKOLCustomControl( Controls[ I ] ), TRUE );\r
12737   FINALLY\r
12738     Controls.Free;\r
12739     if PrntCtrl = nil then\r
12740       AllowRealign := TRUE;\r
12741     Dec( FRealigning );\r
12742   END;\r
12743 \r
12744   LogOK;\r
12745   finally\r
12746   Log( '<-TKOLForm.AlignChildren' );\r
12747   end;\r
12748 end;\r
12749 \r
12750 function TKOLForm.DoNotGenerateSetPosition: Boolean;\r
12751 begin\r
12752   asm\r
12753     jmp @@e_signature\r
12754     DB '#$signature$#', 0\r
12755     DB 'TKOLForm.DoNotGenerateSetPosition', 0\r
12756   @@e_signature:\r
12757   end;\r
12758   Result := FALSE;\r
12759 end;\r
12760 \r
12761 procedure TKOLForm.RealignTimerTick(Sender: TObject);\r
12762 begin\r
12763   asm\r
12764     jmp @@e_signature\r
12765     DB '#$signature$#', 0\r
12766     DB 'TKOLFileFilter.RealignTimerTick', 0\r
12767   @@e_signature:\r
12768   end;\r
12769   Log( '->TKOLForm.RealignTimerTick' );\r
12770   try\r
12771 \r
12772   if not AllowRealign then\r
12773   begin\r
12774     LogOK;\r
12775     Exit;\r
12776   end;\r
12777   if FRealigning > 0 then\r
12778   begin\r
12779     LogOK;\r
12780     Exit;\r
12781   end;\r
12782   FRealignTimer.Enabled := FALSE;\r
12783   Rpt( 'RealignTimerTick' );\r
12784   AlignChildren( nil, TRUE );\r
12785 \r
12786   LogOK;\r
12787   finally\r
12788   Log( '<-TKOLForm.RealignTimerTick' );\r
12789   end;\r
12790 end;\r
12791 \r
12792 procedure TKOLForm.SetMaxHeight(const Value: Integer);\r
12793 begin\r
12794   Log( '->TKOLForm.SetMaxHeight' );\r
12795   try\r
12796   FMaxHeight := Value;\r
12797   Change( Self );\r
12798   LogOK;\r
12799   finally\r
12800   Log( '<-TKOLForm.SetMaxHeight' );\r
12801   end;\r
12802 end;\r
12803 \r
12804 procedure TKOLForm.SetMaxWidth(const Value: Integer);\r
12805 begin\r
12806   Log( '->TKOLForm.SetMaxWidth' );\r
12807   try\r
12808   FMaxWidth := Value;\r
12809   Change( Self );\r
12810   LogOK;\r
12811   finally\r
12812   Log( '<-TKOLForm.SetMaxWidth' );\r
12813   end;\r
12814 end;\r
12815 \r
12816 procedure TKOLForm.SetMinHeight(const Value: Integer);\r
12817 begin\r
12818   Log( '->TKOLForm.SetMinHeight' );\r
12819   try\r
12820   FMinHeight := Value;\r
12821   Change( Self );\r
12822   LogOK;\r
12823   finally\r
12824   Log( '<-TKOLForm.SetMinHeight' );\r
12825   end;\r
12826 end;\r
12827 \r
12828 procedure TKOLForm.SetMinWidth(const Value: Integer);\r
12829 begin\r
12830   Log( '->TKOLForm.SetMinWidth' );\r
12831   try\r
12832   FMinWidth := Value;\r
12833   Change( Self );\r
12834   LogOK;\r
12835   finally\r
12836   Log( '<-TKOLForm.SetMinWidth' );\r
12837   end;\r
12838 end;\r
12839 \r
12840 procedure TKOLForm.SetOnDropFiles(const Value: TOnDropFiles);\r
12841 begin\r
12842   Log( '->SetOnDropFiles' );\r
12843   try\r
12844   FOnDropFiles := Value;\r
12845   Change( Self );\r
12846   LogOK;\r
12847   finally\r
12848   Log( '<-SetOnDropFiles' );\r
12849   end;\r
12850 end;\r
12851 \r
12852 procedure TKOLForm.SetpopupMenu(const Value: TKOLPopupMenu);\r
12853 begin\r
12854   Log( '->TKOLForm.SetpopupMenu' );\r
12855   try\r
12856   FpopupMenu := Value;\r
12857   Change( Self );\r
12858   LogOK;\r
12859   finally\r
12860   Log( '<-TKOLForm.SetpopupMenu' );\r
12861   end;\r
12862 end;\r
12863 \r
12864 procedure TKOLForm.SetOnMaximize(const Value: TOnEvent);\r
12865 begin\r
12866   Log( '->TKOLForm.SetOnMaximize' );\r
12867   try\r
12868   FOnMaximize := Value;\r
12869   Change( Self );\r
12870   LogOK;\r
12871   finally\r
12872   Log( '<-TKOLForm.SetOnMaximize' );\r
12873   end;\r
12874 end;\r
12875 \r
12876 procedure TKOLForm.SetLocalizy(const Value: Boolean);\r
12877 begin\r
12878   Log( '->TKOLForm.SetLocalizy' );\r
12879   try\r
12880   FLocalizy := Value;\r
12881   Change( Self );\r
12882   LogOK;\r
12883   finally\r
12884   Log( '<-TKOLForm.SetLocalizy' );\r
12885   end;\r
12886 end;\r
12887 \r
12888 procedure TKOLForm.MakeResourceString(const ResourceConstName,\r
12889   Value: String);\r
12890 begin\r
12891   Log( '->TKOLForm.MakeResourceString' );\r
12892   try\r
12893   if ResStrings = nil then\r
12894     ResStrings := TStringList.Create;\r
12895   ResStrings.Add( 'resourcestring ' + ResourceConstName + ' = ' + String2Pascal( Value ) + ';' );\r
12896   LogOK;\r
12897   finally\r
12898   Log( '<-TKOLForm.MakeResourceString' );\r
12899   end;\r
12900 end;\r
12901 \r
12902 function TKOLForm.StringConstant(const Propname, Value: String): String;\r
12903 begin\r
12904   Log( '->TKOLForm.StringConstant' );\r
12905   try\r
12906   if Localizy and (Value <> '') then\r
12907   begin\r
12908     Result := Name + '_' + Propname;\r
12909     MakeResourceString( Result, Value );\r
12910   end\r
12911     else\r
12912   begin\r
12913     Result := String2Pascal( Value );\r
12914   end;\r
12915   LogOK;\r
12916   finally\r
12917   Log( '<-TKOLForm.StringConstant' );\r
12918   end;\r
12919 end;\r
12920 \r
12921 procedure TKOLForm.SetHelpContext(const Value: Integer);\r
12922 begin\r
12923   Log( '->TKOLForm.SetHelpContext' );\r
12924   try\r
12925   FHelpContext := Value;\r
12926   Change( Self );\r
12927   LogOK;\r
12928   finally\r
12929   Log( '<-TKOLForm.SetHelpContext' );\r
12930   end;\r
12931 end;\r
12932 \r
12933 procedure TKOLForm.SethelpContextIcon(const Value: Boolean);\r
12934 begin\r
12935   Log( '->TKOLForm.SethelpContextIcon' );\r
12936   try\r
12937   FhelpContextIcon := Value;\r
12938   if Value then\r
12939   begin\r
12940     maximizeIcon := FALSE;\r
12941     minimizeIcon := FALSE;\r
12942   end;\r
12943   Change( Self );\r
12944   LogOK;\r
12945   finally\r
12946   Log( '<-TKOLForm.SethelpContextIcon' );\r
12947   end;\r
12948 end;\r
12949 \r
12950 procedure TKOLForm.SetOnHelp(const Value: TOnHelp);\r
12951 begin\r
12952   Log( '->TKOLForm.SetOnHelp' );\r
12953   try\r
12954   FOnHelp := Value;\r
12955   Change( Self );\r
12956   LogOK;\r
12957   finally\r
12958   Log( '<-TKOLForm.SetOnHelp' );\r
12959   end;\r
12960 end;\r
12961 \r
12962 procedure TKOLForm.SetBrush(const Value: TKOLBrush);\r
12963 begin\r
12964   asm\r
12965     jmp @@e_signature\r
12966     DB '#$signature$#', 0\r
12967     DB 'TKOLForm.SetFont', 0\r
12968   @@e_signature:\r
12969   end;\r
12970   Log( '->TKOLForm.SetBrush' );\r
12971   try\r
12972 \r
12973   if not FLocked then\r
12974   begin\r
12975     FBrush.Assign( Value );\r
12976     Change( Self );\r
12977   end;\r
12978 \r
12979   LogOK;\r
12980   finally\r
12981   Log( '<-TKOLForm.SetBrush' );\r
12982   end;\r
12983 end;\r
12984 \r
12985 {YS}\r
12986 procedure TKOLForm.SetborderStyle(const Value: TKOLFormBorderStyle);\r
12987 begin\r
12988   asm\r
12989     jmp @@e_signature\r
12990     DB '#$signature$#', 0\r
12991     DB 'TKOLForm.SetborderStyle', 0\r
12992   @@e_signature:\r
12993   end;\r
12994   Log( '->TKOLForm.SetborderStyle' );\r
12995   try\r
12996   if not FLocked then\r
12997   begin\r
12998     FborderStyle := Value;\r
12999     if not( csLoading in ComponentState ) then //+VK\r
13000     begin                                      //+VK\r
13001       FHasBorder := Value <> fbsNone;\r
13002       fCanResize := Value <> fbsDialog;\r
13003     end;                                       //+VK\r
13004     Change( Self );\r
13005   end;\r
13006   LogOK;\r
13007   finally\r
13008   Log( '<-TKOLForm.SetborderStyle' );\r
13009   end;\r
13010 end;\r
13011 {YS}\r
13012 \r
13013 function TKOLForm.BestEventName: String;\r
13014 begin\r
13015   Result := 'OnFormCreate';\r
13016 end;\r
13017 \r
13018 procedure TKOLForm.SetShowHint(const Value: Boolean);\r
13019 begin\r
13020   Log( '->TKOLForm.SetShowHint' );\r
13021   try\r
13022   FGetShowHint := Value;\r
13023   Change( Self );\r
13024   LogOK;\r
13025   finally\r
13026   Log( '<-TKOLForm.SetShowHint' );\r
13027   end;\r
13028 end;\r
13029 \r
13030 function TKOLForm.GetShowHint: Boolean;\r
13031 begin\r
13032   Log( '->TKOLForm.GetShowHint' );\r
13033   try\r
13034   if KOLProject <> nil then\r
13035     FGetShowHint := KOLProject.ShowHint;\r
13036   Result := FGetShowHint;\r
13037   LogOK;\r
13038   finally\r
13039   Log( '<-TKOLForm.GetShowHint' );\r
13040   end;\r
13041 end;\r
13042 \r
13043 procedure TKOLForm.SetOnBeforeCreateWindow(const Value: TOnEvent);\r
13044 begin\r
13045   Log( '->TKOLForm.SetOnBeforeCreateWindow' );\r
13046   try\r
13047   FOnBeforeCreateWindow := Value;\r
13048   Change( Self );\r
13049   LogOK;\r
13050   finally\r
13051   Log( '<-TKOLForm.SetOnBeforeCreateWindow' );\r
13052   end;\r
13053 end;\r
13054 \r
13055 procedure TKOLForm.ChangeTimerTick(Sender: TObject);\r
13056 begin\r
13057   Log( '->TKOLForm.ChangeTimerTick' );\r
13058   try\r
13059   FChangeTimer.Enabled := FALSE;\r
13060   DoChangeNow;\r
13061   LogOK;\r
13062   finally\r
13063   Log( '<-TKOLForm.ChangeTimerTick' );\r
13064   end;\r
13065 end;\r
13066 \r
13067 procedure TKOLForm.DoChangeNow;\r
13068 var I: Integer;\r
13069     Success: Boolean;\r
13070     S: String;\r
13071 begin\r
13072   Log( '->TKOLForm.DoChangeNow' );\r
13073   try\r
13074 \r
13075   Success := FALSE;\r
13076   if KOLProject = nil then\r
13077   begin\r
13078     if ToolServices <> nil then\r
13079     begin\r
13080       for I := 0 to ToolServices.GetUnitCount - 1 do\r
13081       begin\r
13082         S := ToolServices.GetUnitName( I );\r
13083         if LowerCase( ExtractFileName( S ) ) = LowerCase( FormUnit + '.pas' ) then\r
13084         begin\r
13085           S := Copy( ExtractFileName( S ), 1, Length( S ) - 4 );\r
13086           if fSourcePath <> '' then\r
13087             S := IncludeTrailingPathDelimiter( fSourcePath ) + S;\r
13088           //ShowMessage( 'Generating w/o KOLProject: ' + S {+#13#10 +\r
13089           //  'csLoading:' + IntToStr( Integer( csLoading in ComponentState ) )} );\r
13090           Success := GenerateUnit( S );\r
13091         end;\r
13092         if Success then break;\r
13093       end;\r
13094       if not Success then\r
13095       begin\r
13096         S := ToolServices.GetCurrentFile;\r
13097         if S <> '' then\r
13098         begin\r
13099           if LowerCase( ExtractFileName( S ) ) = LowerCase( FormUnit + '.pas' ) then\r
13100           begin\r
13101             S := Copy( ExtractFileName( S ), 1, Length( S ) - 4 );\r
13102             if fSourcePath <> '' then\r
13103               S := IncludeTrailingPathDelimiter( fSourcePath ) + S;\r
13104             //ShowMessage( 'Generating w/o KOLProject: ' + S );\r
13105             Success := GenerateUnit( S );\r
13106           end;\r
13107         end;\r
13108       end;\r
13109     end;\r
13110   end;\r
13111   if not Success then\r
13112     inherited Change( Self );\r
13113 \r
13114   LogOK;\r
13115   finally\r
13116   Log( '<-TKOLForm.DoChangeNow' );\r
13117   end;\r
13118 end;\r
13119 \r
13120 { TKOLProject }\r
13121 \r
13122 procedure TKOLProject.AfterGenerateDPR(const SL: TStringList; var Updated: Boolean);\r
13123 begin\r
13124   Log( 'TKOLProject.AfterGenerateDPR' );\r
13125 end;\r
13126 \r
13127 procedure TKOLProject.BeforeGenerateDPR(const SL: TStringList; var Updated: Boolean);\r
13128 begin\r
13129   Log( 'TKOLProject.BeforeGenerateDPR' );\r
13130 end;\r
13131 \r
13132 procedure TKOLProject.BroadCastPaintTypeToAllForms;\r
13133 var I, J: Integer;\r
13134     F: TForm;\r
13135     C: TComponent;\r
13136 begin\r
13137   asm\r
13138     jmp @@e_signature\r
13139     DB '#$signature$#', 0\r
13140     DB 'TKOLProject.BroadCastPaintTypeToAllForms', 0\r
13141   @@e_signature:\r
13142   end;\r
13143   Log( '->TKOLProject.BroadCastPaintTypeToAllForms' );\r
13144   TRY\r
13145 \r
13146     if Screen <> nil then\r
13147     for I := 0 to Screen.FormCount-1 do\r
13148     begin\r
13149       F := Screen.Forms[ I ];\r
13150       for J := 0 to F.ComponentCount-1 do\r
13151       begin\r
13152         C := F.Components[ J ];\r
13153         if C is TKOLForm then\r
13154           (C as TKOLForm).PaintType := PaintType;\r
13155       end;\r
13156     end;\r
13157 \r
13158   LogOK;\r
13159   FINALLY\r
13160     Log( '<-TKOLProject.BroadCastPaintTypeToAllForms' );\r
13161   END;\r
13162 end;\r
13163 \r
13164 procedure TKOLProject.Change;\r
13165 begin\r
13166   asm\r
13167     jmp @@e_signature\r
13168     DB '#$signature$#', 0\r
13169     DB 'TKOLProject.Change', 0\r
13170   @@e_signature:\r
13171   end;\r
13172   Log( '->TKOLProject.Change' );\r
13173   TRY\r
13174 \r
13175   if fChangingNow or FLocked or (csLoading in ComponentState) then\r
13176   begin\r
13177     LogOK;\r
13178     Exit;\r
13179   end;\r
13180   fChangingNow := TRUE;\r
13181   try\r
13182 \r
13183     if AutoBuild then\r
13184     begin\r
13185       if fTimer <> nil then\r
13186       begin\r
13187         if FAutoBuildDelay > 0 then\r
13188         begin\r
13189           Rpt( 'Autobuild timer off/on' );\r
13190           //Rpt_Stack;\r
13191           fTimer.Enabled := False;\r
13192           fTimer.Enabled := True;\r
13193         end\r
13194            else\r
13195         begin\r
13196           Rpt( 'Calling TimerTick directly' );\r
13197           //Rpt_Stack;\r
13198           TimerTick( fTimer );\r
13199         end;\r
13200       end;\r
13201     end;\r
13202 \r
13203   finally\r
13204     fChangingNow := FALSE;\r
13205   end;\r
13206 \r
13207   LogOK;\r
13208   FINALLY\r
13209     Log( '<-TKOLProject.Change' );\r
13210   END;\r
13211 end;\r
13212 \r
13213 function TKOLProject.ConvertVCL2KOL( ConfirmOK: Boolean ): Boolean;\r
13214 var I, E, N: Integer;\r
13215     F: TKolForm;\r
13216     S: String;\r
13217 begin\r
13218   asm\r
13219     jmp @@e_signature\r
13220     DB '#$signature$#', 0\r
13221     DB 'TKOLProject.ConvertVCL2KOL', 0\r
13222   @@e_signature:\r
13223   end;\r
13224   Log( '->TKOLProject.ConvertVCL2KOL' );\r
13225   TRY\r
13226 \r
13227   Result := FALSE;\r
13228   if not FLocked then\r
13229   begin\r
13230     if ProjectDest = '' then\r
13231     begin\r
13232       if not AutoBuilding then\r
13233       ShowMessage( 'You have forgot to assign valid name to ProjectDest property ' +\r
13234                    'TKOLProject component, which define KOL project name after ' +\r
13235                    'converting of your mirror project. It must not much name of any other ' +\r
13236                    'form in your project (FormName property of correspondent ' +\r
13237                    'TKOLForm component). But if You want, it can much the name of ' +\r
13238                    'source project (it will be stored in \KOL subdirectory, created ' +\r
13239                    'in directory with source (mirror) project).' );\r
13240       LogOK;\r
13241       Exit;\r
13242     end;\r
13243     if FormsList = nil then\r
13244     begin\r
13245       if not AutoBuilding then\r
13246       ShowMessage( 'There are not found TKOLForm component instances. You must create '+\r
13247                    'an instance for each form in your mirror project to provide ' +\r
13248                    'converting mirror project to KOL.' );\r
13249       LogOK;\r
13250       Exit;\r
13251     end;\r
13252     FBuilding := True;\r
13253     try\r
13254 \r
13255     fOutdcuPath := '';\r
13256     S := SourcePath;\r
13257     S := S + ProjectDest;\r
13258     E := 0;\r
13259     if not GenerateDPR( S ) then\r
13260       Inc( E );\r
13261     N := 0;\r
13262     if FormsList <> nil then\r
13263     for I := 0 to FormsList.Count - 1 do\r
13264     begin\r
13265       F := FormsList[ I ];\r
13266       if not F.FChanged then continue;\r
13267       S := SourcePath + F.FormUnit;\r
13268       if not F.GenerateUnit( S ) then\r
13269         Inc( E )\r
13270       else\r
13271         Inc( N );\r
13272     end;\r
13273     if E = 0 then\r
13274       if not IsKOLProject then\r
13275         UpdateConfig;\r
13276     if E = 0 then\r
13277     begin\r
13278       S := 'Converting finished successfully.';\r
13279       if not ConfirmOK then S := '';\r
13280       Result := TRUE;\r
13281     end\r
13282     else\r
13283     begin\r
13284       if N > 0 then\r
13285         S := 'Converting finished.'#13 + IntToStr( E ) + ' errors found.';\r
13286     end;\r
13287     if S <> '' then\r
13288       Report( S );\r
13289 \r
13290     except\r
13291       on E: Exception do\r
13292       begin\r
13293         ShowMessage( 'Can not convert VCL to KOL, exception: ' + E.Message );\r
13294       end;\r
13295     end;\r
13296   end;\r
13297 \r
13298   FBuilding := False;\r
13299   LogOK;\r
13300   FINALLY\r
13301     Log( '<-TKOLProject.ConvertVCL2KOL' );\r
13302   END;\r
13303 end;\r
13304 \r
13305 constructor TKOLProject.Create(AOwner: TComponent);\r
13306 var I: Integer;\r
13307     C: TComponent;\r
13308 begin\r
13309   asm\r
13310     jmp @@e_signature\r
13311     DB '#$signature$#', 0\r
13312     DB 'TKOLProject.Create', 0\r
13313   @@e_signature:\r
13314   end;\r
13315   Log( '->TKOLProject.Create' );\r
13316   TRY\r
13317 \r
13318   inherited;\r
13319   fAutoBuild := True;\r
13320   fAutoBuildDelay := 500;\r
13321   fProtect := True;\r
13322   fShowReport := FALSE; // True;\r
13323   fTimer := TTimer.Create( Self );\r
13324   fTimer.Interval := 500;\r
13325   fTimer.OnTimer := TimerTick;\r
13326   fTimer.Enabled := FALSE;\r
13327 \r
13328   if AOwner <> nil then\r
13329   for I := 0 to AOwner.ComponentCount-1 do\r
13330   begin\r
13331     C := AOwner.Components[ I ];\r
13332     if IsVCLControl( C ) then\r
13333     begin\r
13334       FLocked := TRUE;\r
13335       ShowMessage( 'The form ' + AOwner.Name + ' contains already VCL controls.'#13 +\r
13336       'The TKOLProject component is locked now and will not functioning.'#13 +\r
13337       'Just delete it and never drop onto forms, beloning to VCL projects.' );\r
13338       break;\r
13339     end;\r
13340   end;\r
13341   if not FLocked then\r
13342   begin\r
13343 \r
13344     if (KOLProject <> nil) and (KOLProject.Owner <> AOwner) then\r
13345       ShowMessage( 'You have more then one instance of TKOLProject component in ' +\r
13346                    'your mirror project. Please remove all ambigous ones before ' +\r
13347                    'running the project to avoid problems with generating code.' +\r
13348                    ' Or, may be, you open several projects at a time or open main ' +\r
13349                    'form of another KOL&MCK project. This is not allowed.' )\r
13350     else\r
13351     begin\r
13352       KOLProject := Self;\r
13353       if not( csDesigning in ComponentState) then\r
13354       begin\r
13355         ShowMessage( 'You did not finish converting VCL project to MCK. ' +\r
13356                      'Do not forget, that you first must drop TKOLProject on ' +\r
13357                      'form and change its property projectDest, and then drop ' +\r
13358                      'TKOLForm component. Then you can open destination (MCK) project' +\r
13359                      ' and work with it.' );\r
13360         PostQuitMessage( 0 );\r
13361       end;\r
13362     end;\r
13363   end;\r
13364 \r
13365   LogOK;\r
13366   FINALLY\r
13367     Log( '<-TKOLProject.Create' );\r
13368   END;\r
13369 end;\r
13370 \r
13371 destructor TKOLProject.Destroy;\r
13372 begin\r
13373   asm\r
13374     jmp @@e_signature\r
13375     DB '#$signature$#', 0\r
13376     DB 'TKOLProject.Destroy', 0\r
13377   @@e_signature:\r
13378   end;\r
13379   Log( '->TKOLProject.Destroy' );\r
13380   TRY\r
13381 \r
13382   if KOLProject = Self then\r
13383     KOLProject := nil;\r
13384   if FConsoleOut then\r
13385     FreeConsole;\r
13386   ResStrings.Free;\r
13387   inherited;\r
13388 \r
13389   LogOK;\r
13390   FINALLY\r
13391     Log( '<-TKOLProject.Destroy' );\r
13392   END;\r
13393 end;\r
13394 \r
13395 type\r
13396   TFormKind = ( fkNormal, fkMDIParent, fkMDIChild );\r
13397 \r
13398 function FormKind( const FName: String; var ParentFName: String ): TFormKind;\r
13399 const Kinds: array[ TFormKind ] of String = ( 'fkNormal', 'fkMDIParent', 'fkMDIChild' );\r
13400 var I, J: Integer;\r
13401     UN: String;\r
13402     MI: TIModuleInterface;\r
13403     FI: TIFormInterface;\r
13404     FCI, CI: TIComponentInterface;\r
13405     KindDefined: Boolean;\r
13406     S, ObjName, ObjType: String;\r
13407     SL: TStringList;\r
13408 begin\r
13409   asm\r
13410     jmp @@e_signature\r
13411     DB '#$signature$#', 0\r
13412     DB 'FormKind', 0\r
13413   @@e_signature:\r
13414   end;\r
13415   Log( '->FormKind' );\r
13416   TRY\r
13417 \r
13418   Rpt( 'Analizing form: ' + FName );\r
13419   //Rpt_Stack;\r
13420   Result := fkNormal;\r
13421   TRY\r
13422 \r
13423   KindDefined := FALSE;\r
13424   //-- 1. Try to search a form among loaded into the designer.\r
13425   for I := 0 to ToolServices.GetUnitCount-1 do\r
13426   begin\r
13427     UN := ToolServices.GetUnitName( I );\r
13428     MI := ToolServices.GetModuleInterface( UN );\r
13429     if MI <> nil then\r
13430     TRY\r
13431       FI := MI.GetFormInterface;\r
13432       if FI <> nil then\r
13433       TRY\r
13434         FCI := FI.GetFormComponent;\r
13435         if FCI <> nil then\r
13436         TRY\r
13437           S := '';\r
13438           FCI.GetPropValueByName( 'Name', S );\r
13439           Rpt( 'Form component interface obtained for ' + FName +\r
13440                ', Name=' + S + ' (Unit=' + UN + ')' );\r
13441           if StrEq( S, FName ) then\r
13442           for J := 0 to FCI.GetComponentCount-1 do\r
13443           begin\r
13444             CI := FCI.GetComponent( J );\r
13445             if CI.GetComponentType = 'TKOLMDIClient' then\r
13446             begin\r
13447               Rpt( 'TKOLMDIClient found in ' + FName );\r
13448               Result := fkMDIParent;\r
13449               KindDefined := TRUE;\r
13450             end\r
13451               else\r
13452             if CI.GetComponentType = 'TKOLMDIChild' then\r
13453             begin\r
13454               Rpt( 'TKOLMDIChild found in ' + FName );\r
13455               Result := fkMDIChild;\r
13456               CI.GetPropValueByName( 'ParentMDIForm', ParentFName );\r
13457               KindDefined := TRUE;\r
13458             end;\r
13459             if KindDefined then\r
13460             begin\r
13461               LogOK;\r
13462               Exit;\r
13463             end;\r
13464           end\r
13465             else\r
13466           if S = '' then\r
13467           begin\r
13468             if CompareText( ExtractFileExt( UN ), '.pas' ) = 0 then\r
13469             begin\r
13470               SL := TStringList.Create;\r
13471               TRY\r
13472                 SL.LoadFromFile( ChangeFileExt( UN, '.dfm' ) );\r
13473                 Rpt( 'Loaded dfm for ' + UN );\r
13474                 ObjName := '';\r
13475                 ObjType := '';\r
13476                 KindDefined := FALSE;\r
13477                 for J := 0 to SL.Count-1 do\r
13478                 begin\r
13479                   S := Trim( SL[ J ] );\r
13480                   if StrIsStartingFrom( PChar( S ), 'object ' ) then\r
13481                   begin\r
13482                     Parse( S, ' ' );\r
13483                     ObjName := Trim( Parse( S, ':' ) );\r
13484                     ObjType := Trim( S );\r
13485                     if J = 0 then\r
13486                     begin\r
13487                       if not StrEq( ObjName, FName ) then\r
13488                       begin\r
13489                         Rpt( 'Another form - - continue' );\r
13490                         break;\r
13491                       end;\r
13492                     end;\r
13493                     if (ObjType = 'TKOLMDIClient') then\r
13494                     begin\r
13495                       Rpt( 'TKOLMDIClient found for ' + FName + ' in dfm' );\r
13496                       Result := fkMDIParent;\r
13497                       KindDefined := TRUE;\r
13498                     end;\r
13499                   end\r
13500                     else\r
13501                   begin\r
13502                     if not KindDefined and\r
13503                        (ObjType = 'TKOLMDIChild') and\r
13504                        StrIsStartingFrom( PChar( S ), 'ParentMDIForm = ' ) then\r
13505                     begin\r
13506                       Rpt( 'TKOLMDIChild found for ' + FName + ' in dfm' );\r
13507                       Result := fkMDIChild;\r
13508                       KindDefined := TRUE;\r
13509                       Parse( S, '=' );\r
13510                       S := Trim( S );\r
13511                       if Length( S ) > 2 then\r
13512                         S := Copy( S, 2, Length( S ) - 2 );\r
13513                       ParentFName := S;\r
13514                     end;\r
13515                   end;\r
13516                   if KindDefined then\r
13517                   begin\r
13518                     LogOK;\r
13519                     Exit;\r
13520                   end;\r
13521                 end;\r
13522               FINALLY\r
13523                 SL.Free;\r
13524               END;\r
13525             end;\r
13526           end;\r
13527         FINALLY\r
13528           FCI.Free;\r
13529         END;\r
13530       FINALLY\r
13531         FI.Free;\r
13532       END;\r
13533     FINALLY\r
13534       MI.Free;\r
13535     END;\r
13536   end;\r
13537   Result := fkNormal;\r
13538   FINALLY\r
13539     Rpt( 'Analized form ' + FName + 'Kind: ' + Kinds[ Result ] );\r
13540   END;\r
13541 \r
13542   LogOK;\r
13543   FINALLY\r
13544     Log( '<-FormKind' );\r
13545   END;\r
13546 end;\r
13547 \r
13548 procedure ReorderForms( Prj: TKOLProject; Forms: TStringList );\r
13549 var Rslt: TStringList;\r
13550     I, J: Integer;\r
13551     FormName, Name2, ParentFormName, S: String;\r
13552     Kind: TFormKind;\r
13553 begin\r
13554   asm\r
13555     jmp @@e_signature\r
13556     DB '#$signature$#', 0\r
13557     DB 'ReorderForms', 0\r
13558   @@e_signature:\r
13559   end;\r
13560   Log( '->ReorderForms' );\r
13561   TRY\r
13562 \r
13563   Rslt := TStringList.Create;\r
13564   TRY\r
13565     for I := 0 to Forms.Count-1 do\r
13566     begin\r
13567       Kind := FormKind( Forms[ I ], ParentFormName );\r
13568       Forms.Objects[ I ] := Pointer( Kind );\r
13569       if Kind = fkMDIChild then\r
13570         Forms[ I ] := Forms[ I ] + ',' + ParentFormName;\r
13571     end;\r
13572     for I := 0 to Forms.Count-1 do\r
13573     begin\r
13574       FormName := Forms[ I ];\r
13575       if FormName = '' then continue;\r
13576       Kind := TFormKind( Forms.Objects[ I ] );\r
13577       if Kind in [ fkNormal, fkMDIParent ] then\r
13578       begin\r
13579         Rslt.Add( FormName );\r
13580         Forms[ I ] := '';\r
13581       end;\r
13582       if Kind = fkMDIParent then\r
13583       for J := 0 to Forms.Count - 1 do\r
13584       begin\r
13585         Name2 := Forms[ J ];\r
13586         if Name2 = '' then continue;\r
13587         if TFormKind( Forms.Objects[ J ] ) = fkMDIChild then\r
13588         begin\r
13589           S := Name2;\r
13590           Parse( S, ',' );\r
13591           if CompareText( S, FormName ) = 0 then\r
13592           begin\r
13593             Rslt.Add( Name2 );\r
13594             Forms[ J ] := '';\r
13595           end;\r
13596         end;\r
13597       end;\r
13598     end;\r
13599     Forms.Assign( Rslt );\r
13600   FINALLY\r
13601     Rslt.Free;\r
13602   END;\r
13603 \r
13604   LogOK;\r
13605   FINALLY\r
13606     Log( '<-ReorderForms' );\r
13607   END;\r
13608 end;\r
13609 \r
13610 function TKOLProject.GenerateDPR(const Path: String): Boolean;\r
13611 const BeginMark = 'begin // PROGRAM START HERE -- Please do not remove this comment';\r
13612       BeginResourceStringsMark = '// RESOURCE STRINGS START HERE -- Please do not change this section';\r
13613 var SL, Source, AForms: TStringList;\r
13614     A, S, S1, FM: String;\r
13615     I, J: Integer;\r
13616     F: TKOLForm;\r
13617     Found: Boolean;\r
13618     Updated: Boolean;\r
13619     Object2Run: TObject;\r
13620     IsDLL: Boolean;\r
13621     /////////////////////////////////////////////////////////////////////////\r
13622     procedure Prepare_0inc;\r
13623     var SL: TStringList;\r
13624         I, J: Integer;\r
13625         S: String;\r
13626     begin\r
13627       // prepare <ProjectDest>_0.inc, which is to replace\r
13628       // begin .. end. of a project.\r
13629 \r
13630       SL := TStringList.Create;\r
13631       TRY\r
13632 \r
13633       SL.Add( Signature );\r
13634       SL.Add( '{ ' + ProjectDest + '_0.inc' );\r
13635       SL.Add( '  Do not edit this file manually - it is generated automatically.' );\r
13636       SL.Add( '  You can only modify ' + ProjectDest + '_1.inc and ' + ProjectDest + '_3.inc' );\r
13637       SL.Add( '  files. }' );\r
13638       SL.Add( '' );\r
13639 \r
13640       if SupportAnsiMnemonics <> 0 then\r
13641       begin\r
13642         if SupportAnsiMnemonics = 1 then\r
13643           I := GetUserDefaultLCID\r
13644         else\r
13645           I := SupportAnsiMnemonics;\r
13646         SL.Add( '  SupportAnsiMnemonics( $' + IntToHex( I, 8 ) + ' );' );\r
13647       end;\r
13648 \r
13649       if Applet <> nil then\r
13650       begin\r
13651         SL.Add( '  Applet := NewApplet( ''' + Applet.Caption + ''' );' );\r
13652         if not Applet.Visible then\r
13653         begin\r
13654           SL.Add( '  Applet.GetWindowHandle;' );\r
13655           SL.Add( '  Applet.Visible := False;' );\r
13656         end;\r
13657         if (Applet.Icon <> '') or Applet.ForceIcon16x16 then\r
13658         begin\r
13659           if Copy( Applet.Icon, 1, 4 ) = 'IDI_' then\r
13660             SL.Add( '  Applet.IconLoad( 0, ' + Applet.Icon + ' );' )\r
13661           else\r
13662           if Applet.Icon = '-1' then\r
13663             SL.Add( '  Applet.Icon := THandle(-1);' )\r
13664           else\r
13665           begin\r
13666             if (Applet.Icon <> '-1') and Applet.ForceIcon16x16 then\r
13667             begin\r
13668               S := Applet.Icon;\r
13669               if S = '' then\r
13670                 S := 'MAINICON';\r
13671               SL.Add( '  Applet.Icon := LoadImgIcon( ' + String2Pascal( S ) + ', 16 );' );\r
13672             end\r
13673               else\r
13674             SL.Add( '  Applet.IconLoad( hInstance, ''' + Applet.Icon + ''' );' );\r
13675           end;\r
13676         end;\r
13677       end\r
13678         else\r
13679       if not IsDLL then\r
13680       begin\r
13681         for I := 0 to FormsList.Count - 1 do\r
13682         begin\r
13683           F := FormsList[ I ];\r
13684           if F is TKOLFrame then continue;\r
13685           if F.FormMain then\r
13686           begin\r
13687             SL.Add( '  New' + F.FormName + '( ' + F.FormName + ', ' +\r
13688                     A + ' );' );\r
13689             //SL.Add( '  Applet := ' + F.FormName + '.Form;' );\r
13690             A := F.FormName + '.Form';\r
13691             Object2Run := F;\r
13692 \r
13693           end;\r
13694         end;\r
13695       end;\r
13696 \r
13697       SL.Add( '{$I ' + ProjectDest + '_1.inc}' );\r
13698 \r
13699       SL.Add( '' );\r
13700       SL.Add( '{$I ' + ProjectDest + '_2.inc}' );\r
13701 \r
13702       SL.Add( '' );\r
13703       SL.Add( '{$I ' + ProjectDest + '_3.inc}' );\r
13704 \r
13705       SL.Add( '' );\r
13706 \r
13707       FM := '';\r
13708       if FormsList <> nil then\r
13709       for I := 0 to FormsList.Count - 1 do\r
13710       begin\r
13711         F := FormsList[ I ];\r
13712         if F is TKOLFrame then continue;\r
13713         if F.FormMain then\r
13714         begin\r
13715           FM := F.FormName + '.Form';\r
13716           if Object2Run = nil then\r
13717             Object2Run := F;\r
13718         end;\r
13719       end;\r
13720 \r
13721       if A <> 'nil' then\r
13722         FM := A;\r
13723 \r
13724       if (HelpFile <> '') and not IsDLL then\r
13725       begin\r
13726         if StrEq( ExtractFileExt( HelpFile ), '.chm' ) then\r
13727           SL.Add( '  AssignHtmlHelp( ' + StringConstant( 'HelpFile', HelpFile ) + ' );' )\r
13728         else\r
13729           SL.Add( '  Applet.HelpPath := ' + StringConstant( 'HelpFile', HelpFile ) + ';' );\r
13730       end;\r
13731       if not IsDLL then\r
13732       begin\r
13733         TKOLApplet( Object2Run ).GenerateRun( SL, FM );\r
13734         //SL.Add( '  Run( ' + FM + ' );' );\r
13735 \r
13736         if FormsList <> nil then\r
13737         for I := 0 to FormsList.Count - 1 do\r
13738         begin\r
13739           F := FormsList[ I ];\r
13740           if F is TKOLFrame then continue;\r
13741           Found := FALSE;\r
13742           for J := 0 to AForms.Count-1 do\r
13743           begin\r
13744             if CompareText( AForms[ J ], F.FormName ) = 0 then\r
13745             begin\r
13746               Found := TRUE;\r
13747               break;\r
13748             end;\r
13749           end;\r
13750           if Found then\r
13751             F.GenerateDestroyAfterRun( SL );\r
13752         end;\r
13753       end;\r
13754 \r
13755       SL.Add( '' );\r
13756       SL.Add( '{$I ' + ProjectDest + '_4.inc}' );\r
13757 \r
13758       SL.Add( '' );\r
13759       SaveStrings( SL, Path + '_0.inc', Updated );\r
13760 \r
13761       FINALLY\r
13762         SL.Free;\r
13763       END;\r
13764     end;\r
13765 \r
13766     /////////////////////////////////////////////////////////////////////////\r
13767     procedure Prepare_134inc;\r
13768     var SL: TStringList;\r
13769     begin\r
13770 \r
13771       SL := TStringList.Create;\r
13772       TRY\r
13773 \r
13774       // if files _1.inc and _3.inc do not exist, create it (empty).\r
13775 \r
13776       if not FileExists( Path + '_1.inc' ) then\r
13777       begin\r
13778         SL.Add( '{ ' + ProjectDest + '_1.inc' );\r
13779         SL.Add( '  This file is for you. Place here any code to run it' );\r
13780         SL.Add( '  just following Applet creation (if it present) but ' );\r
13781         SL.Add( '  before creating other forms. E.g., You can place here' );\r
13782         SL.Add( '  <IF> statement, which prevents running of application' );\r
13783         SL.Add( '  in some cases. TIP: always use Applet for such checks' );\r
13784         SL.Add( '  and make it invisible until final decision if to run' );\r
13785         SL.Add( '  application or not. }' );\r
13786         SL.Add( '' );\r
13787         SaveStrings( SL, Path + '_1.inc', Updated );\r
13788         SL.Clear;\r
13789       end;\r
13790 \r
13791       if not FileExists( Path + '_3.inc' ) then\r
13792       begin\r
13793         SL.Add( '{ ' + ProjectDest + '_3.inc' );\r
13794         SL.Add( '  This file is for you. Place here any code to run it' );\r
13795         SL.Add( '  after forms creating, but before Run call, if necessary. }' );\r
13796         SL.Add( '' );\r
13797         SaveStrings( SL, Path + '_3.inc', Updated );\r
13798         SL.Clear;\r
13799       end;\r
13800 \r
13801       if not FileExists( Path + '_4.inc' ) then\r
13802       begin\r
13803         SL.Add( '{ ' + ProjectDest + '_4.inc' );\r
13804         SL.Add( '  This file is for you. Place here any code to be inserted' );\r
13805         SL.Add( '  after Run call, if necessary. }' );\r
13806         SL.Add( '' );\r
13807         SaveStrings( SL, Path + '_4.inc', Updated );\r
13808         SL.Clear;\r
13809       end;\r
13810 \r
13811       FINALLY\r
13812         SL.Free;\r
13813       END;\r
13814     end;\r
13815 \r
13816     ////////////////////////////////////////////////////////////////////////\r
13817     procedure Prepare_2inc;\r
13818     var SL: TStringList;\r
13819         I, J: Integer;\r
13820     begin\r
13821       SL := TStringList.Create;\r
13822       TRY\r
13823       // for now, generate <ProjectName>_2.inc\r
13824       SL.Add( Signature );\r
13825       SL.Add( '{ ' + ProjectDest + '_2.inc' );\r
13826       SL.Add( '  Do not modify this file manually - it is generated automatically. }' );\r
13827       SL.Add( '' );\r
13828 \r
13829       if not IsDLL then\r
13830       begin\r
13831         for I := 0 to AForms.Count - 1 do\r
13832         begin\r
13833           S := AForms[ I ];\r
13834           S := Trim( Parse( S, ',' ) );\r
13835           F := nil;\r
13836           for J := 0 to FormsList.Count - 1 do\r
13837           begin\r
13838             F := FormsList[ J ];\r
13839             if CompareText( AForms[ I ], F.formName ) = 0 then\r
13840               break\r
13841             else\r
13842               F := nil;\r
13843               // Ýòî íåäîñòàòî÷íî, ÷òîáû ðåøèòü, ÷òî ïåðåä íàìè frame, à íå form.\r
13844               // Ôðåéì äîëæåí áûòü èñêëþ÷åí èç ñïèñêà àâòî-create.\r
13845           end;\r
13846           if (F <> nil) and (F is TKOLFrame) then continue;\r
13847           //Rpt( 'AutoForm: ' + S );\r
13848           if LowerCase( A ) = LowerCase( S + '.Form' ) then Continue;\r
13849           if pos( ',', AForms[ I ] ) > 0 then\r
13850           begin\r
13851             // MDI child form\r
13852             S1 := AForms[ I ];\r
13853             Parse( S1, ',' );\r
13854             SL.Add( '  New' + Trim( S ) + '( ' + Trim( S ) + ', ' +\r
13855                     Trim( S1 ) + '.Form );' );\r
13856           end\r
13857             else\r
13858           begin\r
13859             // normal or MDI parent form\r
13860             SL.Add( '  New' + S + '( ' + S + ', Pointer( ' + A + ' ) );' );\r
13861           end;\r
13862         end;\r
13863       end;\r
13864 \r
13865       SaveStrings( SL, Path + '_2.inc', Updated );\r
13866 \r
13867       FINALLY\r
13868         SL.Free;\r
13869       END;\r
13870     end;\r
13871 \r
13872     /////////////////////////////////////////////////////////////////////////\r
13873 \r
13874 begin\r
13875   asm\r
13876     jmp @@e_signature\r
13877     DB '#$signature$#', 0\r
13878     DB 'TKOLProject.GenerateDPR', 0\r
13879   @@e_signature:\r
13880   end;\r
13881   Log( '->TKOLProject.GenerateDPR' );\r
13882   TRY\r
13883 \r
13884   Rpt( 'Generating DPR for ' + Path ); //Rpt_Stack;\r
13885   Result := False;\r
13886   if FLocked then\r
13887   begin\r
13888     LogOK; Exit;\r
13889   end;\r
13890   Updated := FALSE;\r
13891   SL := TStringList.Create;\r
13892   Source := TStringList.Create;\r
13893   AForms := TStringList.Create;\r
13894 \r
13895   try\r
13896 \r
13897   ResStrings.Free;\r
13898   ResStrings := nil;\r
13899 \r
13900   // First, generate <ProjectName>.dpr\r
13901   S := ExtractFilePath( Path ) + ProjectName + '.dpr';\r
13902   LoadSource( Source, S );\r
13903   IsDLL := FALSE;\r
13904   for I := 0 to Source.Count-1 do\r
13905   begin\r
13906     if pos( 'library', LowerCase( Source[ I ] ) ) > 0 then\r
13907     begin\r
13908       IsDLL := TRUE;\r
13909       break;\r
13910     end\r
13911       else\r
13912     if pos( 'program', LowerCase( Source[ I ] ) ) > 0 then\r
13913       break;\r
13914   end;\r
13915   if Source.Count = 0 then\r
13916   begin\r
13917     S := ExtractFilePath( Path ) + ExtractFileNameWOExt( Path ) + '.dpr';\r
13918     LoadSource( Source, S );\r
13919   end;\r
13920   if Source.Count = 0 then\r
13921   begin\r
13922     Rpt( 'Could not get source from ' + S );\r
13923     SL.Free;\r
13924     Source.Free;\r
13925     LogOK;\r
13926     Exit;\r
13927   end;\r
13928 \r
13929   BeforeGenerateDPR( SL, Updated );\r
13930 \r
13931   Object2Run := nil;\r
13932   A := 'nil';\r
13933   if Applet <> nil then  // TODO: TKOLApplet must be on main form\r
13934   begin                  // (to be always available for TKOLProject)\r
13935     A := 'Applet';\r
13936     Object2Run := Applet;\r
13937   end;\r
13938 \r
13939   SL.Clear;\r
13940 \r
13941   J := -1;\r
13942   for I := 0 to Source.Count - 1 do\r
13943   begin\r
13944     if Source[ I ] = 'begin' then\r
13945     begin\r
13946       if J = -1 then J := I else J := -2;\r
13947     end;\r
13948     if Source[ I ] = BeginMark then\r
13949     begin\r
13950       J := I; break;\r
13951     end;\r
13952   end;\r
13953   if J >= 0 then\r
13954     Source[ J ] := BeginMark\r
13955   else\r
13956   begin\r
13957     ShowMessage( 'Error while converting dpr: begin markup could not be found. ' +\r
13958                  'Dpr-file of the project must either have a single line having only ' +\r
13959                  '''begin'' reserved word at the beginning or such line must be marked ' +\r
13960                  'with special comment:'#13 +\r
13961                  BeginMark );\r
13962     LogOK;\r
13963     Exit;\r
13964   end;\r
13965   // copy lines from the first to 'begin', making\r
13966   // some changes:\r
13967   SL.Add( Signature ); // insert signature\r
13968   S := '';\r
13969   I := -1;\r
13970   while I < Source.Count - 1 do\r
13971   begin\r
13972     Inc( I );\r
13973     S := Source[ I ];\r
13974     if S = Signature then continue; // skip signature if present\r
13975     if LowerCase( Trim( S ) ) = LowerCase( 'program ' + ProjectName + ';' ) then\r
13976     begin\r
13977       SL.Add( 'program ' + ProjectDest + ';' );\r
13978       continue;\r
13979     end;\r
13980     if (LowerCase( Trim( S ) ) = LowerCase( 'library ' + ProjectName + ';' ))\r
13981     then\r
13982     begin\r
13983       SL.Add( 'library ' + ProjectDest + ';' );\r
13984       continue;\r
13985     end;\r
13986     if S = BeginMark then\r
13987       break;\r
13988     if LowerCase( Trim( S ) ) = 'uses' then\r
13989     begin\r
13990       SL.Add( S );\r
13991       SL.Add( 'KOL,' );\r
13992       continue;\r
13993     end;\r
13994     J := pos( 'KOL,', S );\r
13995     if J > 0 then\r
13996     begin\r
13997       S := Copy( S, 1, J-1 ) + Copy( S, J+4, Length( S )-J-3 );\r
13998       if Trim( S ) = '' then continue;\r
13999     end;\r
14000     J := pos( 'Forms,', S );\r
14001     if J > 0 then // remove reference to Forms.pas\r
14002     begin\r
14003       S := Copy( S, 1, J-1 ) + Copy( S, J+6, Length( S )-J-5 );\r
14004       if Trim( S ) = '' then continue;\r
14005     end;\r
14006     J := pos( '{$r *.res}', LowerCase( S ) );\r
14007     if J > 0 then // remove/insert reference to project resource file\r
14008       if DprResource then\r
14009         S := '{$R *.res}'\r
14010       else\r
14011         S := '//{$R *.res}';\r
14012     SL.Add( S );\r
14013   end;\r
14014   SL.Add( BeginMark );\r
14015   SL.Add( '' );\r
14016   SL.Add( '{$IFDEF KOL_MCK} {$I ' + ProjectDest + '_0.inc} {$ELSE}' );\r
14017   SL.Add( '' );\r
14018 \r
14019   // copy the rest of source dpr - between begin .. end.\r
14020   // and store all autocreated forms in AForms string list\r
14021   while I < Source.Count - 1 do\r
14022   begin\r
14023     Inc( I );\r
14024     S := Source[ I ];\r
14025     if Trim( S ) = '' then continue;\r
14026 \r
14027     if UpperCase( S ) = UpperCase( '{$IFDEF KOL_MCK} {$I ' + ProjectDest + '_0.INC} {$ELSE}' ) then\r
14028       continue;\r
14029     if UpperCase( S ) = '{$ENDIF}' then\r
14030       continue;\r
14031     if LowerCase( S ) = 'end.' then\r
14032     begin\r
14033       SL.Add( '' );\r
14034       SL.Add( '{$ENDIF}' );\r
14035       SL.Add( '' );\r
14036     end;\r
14037 \r
14038     SL.Add( S );\r
14039 \r
14040     J := pos( 'application.createform(', LowerCase( S ) );\r
14041     if J > 0 then\r
14042     begin\r
14043       S := Copy( S, J + 23, Length( S ) - J - 22 );\r
14044       J := pos( ',', S );\r
14045       if J > 0 then\r
14046         S := Copy( S, J + 1, Length( S ) - J );\r
14047       J := pos( ')', S );\r
14048       if J > 0 then\r
14049         S := Copy( S, 1, J - 1 );\r
14050       AForms.Add( Trim( S ) );\r
14051     end;\r
14052   end;\r
14053   ReorderForms( Self, AForms );\r
14054 \r
14055   Prepare_0inc;\r
14056   Prepare_134inc;\r
14057   Prepare_2inc;\r
14058 \r
14059   if (ResStrings <> nil) and (ResStrings.Count > 0) then\r
14060   begin\r
14061     for I := 0 to SL.Count-1 do\r
14062     begin\r
14063       S := SL[ I ];\r
14064       if S = BeginResourceStringsMark then\r
14065       begin\r
14066         while S <> BeginMark do\r
14067         begin\r
14068           SL.Delete( I );\r
14069           if I >= SL.Count then\r
14070           begin\r
14071             Rpt( 'Error: begin mark not found' );\r
14072             break;\r
14073           end;\r
14074           S := SL[ I ];\r
14075         end;\r
14076       end;\r
14077       if S = BeginMark then\r
14078       begin\r
14079         SL.Insert( I, BeginResourceStringsMark );\r
14080         for J := ResStrings.Count-1 downto 0 do\r
14081           SL.Insert( I + 1, ResStrings[ J ] );\r
14082         //Updated := TRUE;\r
14083         break;\r
14084       end;\r
14085     end;\r
14086   end;\r
14087 \r
14088   AfterGenerateDPR( SL, Updated );\r
14089   // store SL as <ProjectDest>.dpr\r
14090   SaveStrings( SL, Path + '.dpr', Updated );\r
14091 \r
14092 \r
14093   // at last, generate code for all (opened in designer) forms\r
14094 \r
14095   if FormsList <> nil then\r
14096   for I := 0 to FormsList.Count - 1 do\r
14097   begin\r
14098     F := FormsList[ I ];\r
14099     F.GenerateUnit( ExtractFilePath( Path ) + F.FormUnit );\r
14100   end;\r
14101 \r
14102   if Updated then\r
14103   begin\r
14104     // mark modified here\r
14105     MarkModified( Path + '.dpr' );\r
14106     MarkModified( Path + '_1.inc' );\r
14107     MarkModified( Path + '_2.inc' );\r
14108     MarkModified( Path + '_3.inc' );\r
14109   end;\r
14110 \r
14111   Result := True;\r
14112 \r
14113   except on E: Exception do\r
14114          begin\r
14115            SL := TStringList.Create;\r
14116            TRY\r
14117              SL := GetCallStack;\r
14118              ShowMessage( 'Exception 11873: ' + E.Message + #13#10 + SL.Text );\r
14119            FINALLY\r
14120              SL.Free;\r
14121            END;\r
14122          end;\r
14123   end;\r
14124 \r
14125   SL.Free;\r
14126   Source.Free;\r
14127   AForms.Free;\r
14128 \r
14129   LogOK;\r
14130   FINALLY\r
14131     Log( '<-TKOLProject.GenerateDPR' );\r
14132   END;\r
14133 end;\r
14134 \r
14135 function TKOLProject.GetBuild: Boolean;\r
14136 begin\r
14137   asm\r
14138     jmp @@e_signature\r
14139     DB '#$signature$#', 0\r
14140     DB 'TKOLProject.GetBuild', 0\r
14141   @@e_signature:\r
14142   end;\r
14143   Result := fBuild;\r
14144 end;\r
14145 \r
14146 function TKOLProject.GetIsKOLProject: Boolean;\r
14147 var SL: TStringList;\r
14148     I: Integer;\r
14149 begin\r
14150   asm\r
14151     jmp @@e_signature\r
14152     DB '#$signature$#', 0\r
14153     DB 'TKOLProject.GetIsKOLProject', 0\r
14154   @@e_signature:\r
14155   end;\r
14156   Log( '->GetIsKOLProject' );\r
14157   TRY\r
14158 \r
14159   Result := FALSE;\r
14160   if not FLocked then\r
14161   begin\r
14162     if fIsKOL = 0 then\r
14163     begin\r
14164       //ShowMessage( 'find if project Is KOL...' );\r
14165       if (SourcePath <> '') and DirectoryExists( SourcePath ) and\r
14166          (ProjectName <> '') and FileExists( SourcePath + ProjectName + '.dpr' ) then\r
14167       begin\r
14168         //ShowMessage( 'find if project Is KOL in ' + SourcePath + ProjectName + '.dpr' );\r
14169         SL := TStringList.Create;\r
14170         try\r
14171           LoadSource( SL, SourcePath + ProjectName + '.dpr' );\r
14172           for I := 0 to SL.Count - 1 do\r
14173             if SL[ I ] = Signature then\r
14174             begin\r
14175               fIsKOL := 1;\r
14176               break;\r
14177             end;\r
14178           //if fIsKOL = 0 then\r
14179           //  fIsKOL := -1;\r
14180         finally\r
14181           SL.Free;\r
14182         end;\r
14183         //ShowMessage( IntToStr( fIsKOL ) );\r
14184       end;\r
14185     end;\r
14186     Result := fIsKOL > 0;\r
14187   end;\r
14188 \r
14189   LogOK;\r
14190   FINALLY\r
14191     Log( '<-GetIsKOLProject' );\r
14192   END;\r
14193 end;\r
14194 \r
14195 function TKOLProject.GetOutdcuPath: TFileName;\r
14196 var S: String;\r
14197     L: TStringList;\r
14198     I: Integer;\r
14199 begin\r
14200   asm\r
14201     jmp @@e_signature\r
14202     DB '#$signature$#', 0\r
14203     DB 'TKOLProject.GetOutdcuPath', 0\r
14204   @@e_signature:\r
14205   end;\r
14206   Log( '->TKOLProject.GetOutdcuPath' );\r
14207   TRY\r
14208 \r
14209   Result := '';\r
14210   if not FLocked then\r
14211   begin\r
14212     Result := SourcePath;\r
14213     S := SourcePath + ProjectName + '.cfg';\r
14214     if FileExists( S ) then\r
14215     begin\r
14216       L := TStringList.Create;\r
14217       L.LoadFromFile( S );\r
14218       for I := 0 to L.Count - 1 do\r
14219       begin\r
14220         if Length( L[ I ] ) < 2 then continue;\r
14221         if L[ I ][ 2 ] = 'N' then\r
14222         begin\r
14223           S := Trim( Copy( L[ I ], 3, Length( L[ I ] ) - 2 ) );\r
14224           if S[ 1 ] = '"' then\r
14225             S := Copy( S, 2, Length( S ) - 1 );\r
14226           if S[ Length( S ) ] = '"' then\r
14227             S := Copy( S, 1, Length( S ) - 1 );\r
14228           Result := S;\r
14229           break;\r
14230         end;\r
14231       end;\r
14232       L.Free;\r
14233     end;\r
14234 \r
14235     if Result = '' then\r
14236       Result := fOutdcuPath;\r
14237     if Result <> '' then\r
14238     if Result[ Length( Result ) ] <> '\' then\r
14239       Result := Result + '\';\r
14240     fOutdcuPath := Result;\r
14241   end;\r
14242 \r
14243   LogOK;\r
14244   FINALLY\r
14245     Log( '<-TKOLProject.GetOutdcuPath' );\r
14246   END;\r
14247 end;\r
14248 \r
14249 function TKOLProject.GetProjectDest: String;\r
14250 begin\r
14251   asm\r
14252     jmp @@e_signature\r
14253     DB '#$signature$#', 0\r
14254     DB 'TKOLProject.GetProjectDest', 0\r
14255   @@e_signature:\r
14256   end;\r
14257   Log( '->TKOLProject.GetProjectDest' );\r
14258   TRY\r
14259 \r
14260   Result := '';\r
14261   if not FLocked then\r
14262   begin\r
14263     //Result := ProjectName;\r
14264     if IsKOLProject then\r
14265       Result := ProjectName\r
14266     else\r
14267     begin\r
14268       Result := FProjectDest;\r
14269       if (ProjectName <> '') and (LowerCase(Result) = LowerCase(ProjectName)) then\r
14270         Result := '';\r
14271     end;\r
14272   end;\r
14273 \r
14274   LogOK;\r
14275   FINALLY\r
14276     Log( '<-TKOLProject.GetProjectDest' );\r
14277   END;\r
14278 end;\r
14279 \r
14280 function TKOLProject.GetProjectName: String;\r
14281 var Wnd: HWnd;\r
14282     Len, I: Integer;\r
14283 begin\r
14284   asm\r
14285     jmp @@e_signature\r
14286     DB '#$signature$#', 0\r
14287     DB 'TKOLProject.GetProjectName', 0\r
14288   @@e_signature:\r
14289   end;\r
14290   Log( '->TKOLProject.GetProjectName' );\r
14291   TRY\r
14292 \r
14293   Result := fProjectName;\r
14294   if csDesigning in ComponentState then\r
14295   begin\r
14296     if ToolServices <> nil then\r
14297     begin\r
14298       Result := ExtractFileNameWOExt( ToolServices.GetProjectName );\r
14299       LogOK;\r
14300       exit;\r
14301     end;\r
14302     Wnd := FindWindow( 'TAppBuilder', nil );\r
14303     if Wnd <> 0 then\r
14304     begin\r
14305       Len := GetWindowTextLength( Wnd );\r
14306       if Len > 0 then\r
14307       begin\r
14308         SetString( Result, nil, Len );\r
14309         GetWindowText( Wnd, PChar( Result ), Len + 1 );\r
14310         I := pos( '-', Result );\r
14311         if I > 0 then\r
14312           Result := Trim( Copy( Result, I + 1, Length( Result ) - I ) );\r
14313         if pos( '[', Result ) > 0 then\r
14314           Result := Trim( Copy( Result, 1, pos( '[', Result ) - 1 ) ); \r
14315         if pos( '(', Result ) > 0 then\r
14316           Result := Trim( Copy( Result, 1, pos( '(', Result ) - 1 ) );\r
14317       end;\r
14318     end;\r
14319   end;\r
14320 \r
14321   LogOK;\r
14322   FINALLY\r
14323     Log( '<-TKOLProject.GetProjectName' )\r
14324   END;\r
14325 end;\r
14326 \r
14327 function TKOLProject.GetShowReport: Boolean;\r
14328 begin\r
14329   asm\r
14330     jmp @@e_signature\r
14331     DB '#$signature$#', 0\r
14332     DB 'TKOLProject.GetShowReport', 0\r
14333   @@e_signature:\r
14334   end;\r
14335   //Log( '->TKOLProject.GetShowReport' );\r
14336   TRY\r
14337 \r
14338   Result := fShowReport;\r
14339   if AutoBuilding then\r
14340     Result := False;\r
14341 \r
14342   LogOK;\r
14343   FINALLY\r
14344     //Log( '<-TKOLProject.GetShowReport' );\r
14345   END;\r
14346 end;\r
14347 \r
14348 {$IFDEF _D2}\r
14349 function SHBrowseForFolder(var lpbi: TBrowseInfo): PItemIDList; stdcall;\r
14350   external 'shell32.dll' name 'SHBrowseForFolderA';\r
14351 function SHGetPathFromIDList(pidl: PItemIDList; pszPath: PChar): BOOL; stdcall;\r
14352   external 'shell32.dll' name 'SHGetPathFromIDListA';\r
14353 procedure CoTaskMemFree(pv: Pointer); stdcall;\r
14354   external 'ole32.dll' name 'CoTaskMemFree';\r
14355 {$ENDIF}\r
14356 \r
14357 function TKOLProject.GetSourcePath: TFileName;\r
14358 var BI: TBrowseInfo;\r
14359     IIL: PItemIdList;\r
14360     Buf: array[ 0..MAX_PATH ] of Char;\r
14361     SL: TStringList;\r
14362 begin\r
14363   asm\r
14364     jmp @@e_signature\r
14365     DB '#$signature$#', 0\r
14366     DB 'TKOLProject.GetSourcePath', 0\r
14367   @@e_signature:\r
14368   end;\r
14369   Log( '->TKOLProject.GetSourcePath' );\r
14370   TRY\r
14371 \r
14372   Result := '';\r
14373   TRY\r
14374     if FLocked then\r
14375     begin\r
14376       LogOK; Exit;\r
14377     end;\r
14378     Result := fSourcePath;\r
14379     if Result <> '' then\r
14380       if Result[ Length( Result ) ] <> '\' then\r
14381         Result := Result + '\';\r
14382     if (Result <> '') and DirectoryExists( Result ) {and (FprojectDest <> '') and\r
14383        FileExists( Result + FprojectDest + '.dpr' )} then\r
14384     begin\r
14385       LogOK; Exit;\r
14386     end;\r
14387     if fGettingSourcePath then\r
14388     begin\r
14389       LogOK; Exit;\r
14390     end;\r
14391     fGettingSourcePath := True;\r
14392     TRY\r
14393       try\r
14394         if Result <> '' then\r
14395         if Result[ Length( Result ) ] <> '\' then\r
14396           Result := Result + '\';\r
14397         if Result <> '' then\r
14398         if not DirectoryExists( Result ) or\r
14399            not FileExists( Result + fprojectDest + '.dpr' ) or\r
14400            not IsKOLProject then\r
14401            Result := '';\r
14402         if Result = '' then\r
14403         if csDesigning in ComponentState then\r
14404         //if not (csLoading in ComponentState) then\r
14405         begin\r
14406           try\r
14407             if ToolServices <> nil then\r
14408             begin\r
14409               Result := ToolServices.GetProjectName;\r
14410               Result := ExtractFilePath( Result );\r
14411             end;\r
14412           except on E: Exception do\r
14413              begin\r
14414                SL := TStringList.Create;\r
14415                TRY\r
14416                  SL := GetCallStack;\r
14417                  ShowMessage( 'Exception 12108: ' + E.Message + #13#10 + SL.Text );\r
14418                FINALLY\r
14419                  SL.Free;\r
14420                END;\r
14421              end;\r
14422           end;\r
14423 \r
14424           if Result <> '' then\r
14425           begin\r
14426             if Result[ Length( Result ) ] <> '\' then\r
14427               Result := Result + '\';\r
14428             fGettingSourcePath := False;\r
14429             LogOK;\r
14430             Exit;\r
14431           end;\r
14432 \r
14433           FillChar( BI, Sizeof( BI ), 0 );\r
14434           BI.lpszTitle := 'Define mirror project source (directory ' +\r
14435                           'where your source project is located before '+\r
14436                           'converting it to KOL).';\r
14437           BI.ulFlags := BIF_RETURNONLYFSDIRS;\r
14438           BI.pszDisplayName := @Buf[ 0 ];\r
14439           IIL := SHBrowseForFolder( BI );\r
14440           if IIL <> nil then\r
14441           begin\r
14442             SHGetPathFromIDList( IIL, @Buf[ 0 ] );\r
14443             CoTaskMemFree( IIL );\r
14444             Result := Buf;\r
14445             fSourcePath := Result;\r
14446           end;\r
14447         end;\r
14448         if Result <> '' then\r
14449         if Result[ Length( Result ) ] <> '\' then\r
14450           Result := Result + '\';\r
14451       except on E: Exception do\r
14452              begin\r
14453                SL := TStringList.Create;\r
14454                TRY\r
14455                  SL := GetCallStack;\r
14456                  ShowMessage( 'Exception 12146: ' + E.Message + #13#10 + SL.Text );\r
14457                FINALLY\r
14458                  SL.Free;\r
14459                END;\r
14460              end;\r
14461       end;\r
14462     FINALLY\r
14463       fGettingSourcePath := False;\r
14464     END;\r
14465   EXCEPT\r
14466     on E: Exception do\r
14467     begin\r
14468       ShowMessage( 'Can not obtain project source path, exception: ' + E.Message );\r
14469       Result := '';\r
14470     end;\r
14471   END;\r
14472 \r
14473   LogOK;\r
14474   FINALLY\r
14475     Log( '<-TKOLProject.GetSourcePath' );\r
14476   END;\r
14477 end;\r
14478 \r
14479 procedure TKOLProject.Loaded;\r
14480 begin\r
14481   asm\r
14482     jmp @@e_signature\r
14483     DB '#$signature$#', 0\r
14484     DB 'TKOLProject.Loaded', 0\r
14485   @@e_signature:\r
14486   end;\r
14487   Log( '->TKOLProject.Loaded' );\r
14488   TRY\r
14489     inherited;\r
14490     //fTimer.Enabled := TRUE;\r
14491     BroadCastPaintTypeToAllForms;\r
14492   LogOK;\r
14493   FINALLY\r
14494     Log( '<-TKOLProject.Loaded' );\r
14495   END;\r
14496 end;\r
14497 \r
14498 procedure TKOLProject.MakeResourceString(const ResourceConstName,\r
14499   Value: String);\r
14500 begin\r
14501   Log( '->TKOLProject.MakeResourceString' );\r
14502   TRY\r
14503 \r
14504   if ResStrings = nil then\r
14505     ResStrings := TStringList.Create;\r
14506   ResStrings.Add( 'resourcestring ' + ResourceConstName + ' = ' + String2Pascal( Value ) + ';' );\r
14507 \r
14508   LogOK;\r
14509   FINALLY\r
14510     Log( '<-TKOLProject.MakeResourceString' );\r
14511   END;\r
14512 end;\r
14513 \r
14514 procedure TKOLProject.Report(const Txt: String);\r
14515 begin\r
14516   asm\r
14517     jmp @@e_signature\r
14518     DB '#$signature$#', 0\r
14519     DB 'TKOLProject.Report', 0\r
14520   @@e_signature:\r
14521   end;\r
14522   if FLocked then Exit;\r
14523   if FConsoleOut and (FOut <> 0) then\r
14524     Writeln( FOut, Txt );\r
14525   if ShowReport and Building then\r
14526     ShowMessage( Txt );\r
14527 end;\r
14528 \r
14529 procedure TKOLProject.SetAutoBuild(const Value: Boolean);\r
14530 begin\r
14531   asm\r
14532     jmp @@e_signature\r
14533     DB '#$signature$#', 0\r
14534     DB 'TKOLProject.SetAutoBuild', 0\r
14535   @@e_signature:\r
14536   end;\r
14537   Log( '->TKOLProject.SetAutoBuild' );\r
14538   TRY\r
14539 \r
14540   if not FLocked then\r
14541   begin\r
14542     if fAutoBuild <> Value then\r
14543     begin\r
14544       fAutoBuild := Value;\r
14545       if Value then\r
14546       begin\r
14547         // Setup timer\r
14548         if fTimer = nil then\r
14549           fTimer := TTimer.Create( Self );\r
14550         fTimer.Interval := FAutoBuildDelay;\r
14551         fTimer.OnTimer := TimerTick;\r
14552       end\r
14553          else\r
14554       begin\r
14555         // Stop timer\r
14556         if fTimer <> nil then\r
14557           fTimer.Enabled := False;\r
14558       end;\r
14559     end;\r
14560   end;\r
14561 \r
14562   LogOK;\r
14563   FINALLY\r
14564     Log( '<-TKOLProject.SetAutoBuild' );\r
14565   END;\r
14566 end;\r
14567 \r
14568 procedure TKOLProject.SetAutoBuildDelay(const Value: Integer);\r
14569 begin\r
14570   asm\r
14571     jmp @@e_signature\r
14572     DB '#$signature$#', 0\r
14573     DB 'TKOLProject.SetAutoBuildDelay', 0\r
14574   @@e_signature:\r
14575   end;\r
14576   Log( '->TKOLProject.SetAutoBuildDelay' );\r
14577   TRY\r
14578 \r
14579   if not FLocked then\r
14580   begin\r
14581     FAutoBuildDelay := Value;\r
14582     if fAutoBuildDelay < 0 then\r
14583       fAutoBuildDelay := 0;\r
14584     if AutoBuildDelay > 3000 then\r
14585       fAutoBuildDelay := 3000;\r
14586     if fTimer <> nil then\r
14587     if fAutoBuildDelay > 50 then\r
14588       fTimer.Interval := Value\r
14589     else\r
14590       fTimer.Interval := 50;\r
14591   end;\r
14592   LogOK;\r
14593   FINALLY\r
14594     Log( '<-TKOLProject.SetAutoBuildDelay' );\r
14595   END;\r
14596 end;\r
14597 \r
14598 procedure TKOLProject.SetBuild(const Value: Boolean);\r
14599 var S: String;\r
14600 begin\r
14601   asm\r
14602     jmp @@e_signature\r
14603     DB '#$signature$#', 0\r
14604     DB 'TKOLProject.SetBuild', 0\r
14605   @@e_signature:\r
14606   end;\r
14607   Log( '->TKOLProject.SetBuild' );\r
14608   TRY\r
14609 \r
14610   if not (csLoading in ComponentState) and not FLocked then\r
14611   begin\r
14612     if not IsKOLProject then\r
14613     begin\r
14614       S := 'Option <Build> is not available at design time ' +\r
14615            'unless project is already converted to KOL-MCK.';\r
14616       if projectDest = '' then\r
14617         S := S + #13#10'To convert a project to KOL-MCK, change property ' +\r
14618              'projectDest of TKOLProject component!';\r
14619       ShowMessage( S );\r
14620       LogOK;\r
14621       Exit;\r
14622     end;\r
14623     if Value = False then\r
14624     begin\r
14625       LogOK;\r
14626       Exit;\r
14627     end;\r
14628     fBuild := Value;\r
14629     try\r
14630       ConvertVCL2KOL( TRUE );\r
14631     except\r
14632       on E: Exception do\r
14633       begin\r
14634         ShowMessage( 'ConvertVCL2KOL failed, exception: ' + E.Message );\r
14635       end;\r
14636     end;\r
14637     fBuild := False;\r
14638   end;\r
14639 \r
14640   LogOK;\r
14641   FINALLY\r
14642     Log( '<-TKOLProject.SetBuild' );\r
14643   END;\r
14644 end;\r
14645 \r
14646 procedure TKOLProject.SetConsoleOut(const Value: Boolean);\r
14647 begin\r
14648   asm\r
14649     jmp @@e_signature\r
14650     DB '#$signature$#', 0\r
14651     DB 'TKOLProject.SetConsoleOut', 0\r
14652   @@e_signature:\r
14653   end;\r
14654   Log( '->TKOLProject.SetConsoloeOut' );\r
14655   TRY\r
14656 \r
14657   if not FLocked and (FConsoleOut <> Value) then\r
14658   begin\r
14659     FConsoleOut := Value;\r
14660     if Value then\r
14661     begin\r
14662       AllocConsole;\r
14663       FOut := GetStdHandle( STD_OUTPUT_HANDLE );\r
14664       if FOut <> 0 then\r
14665       begin\r
14666         FIn := GetStdHandle( STD_INPUT_HANDLE );\r
14667         SetConsoleTitle( 'KOL MCK console. Do not close! (use prop. ConsoleOut)' );\r
14668         SetConsoleMode( FIn, ENABLE_PROCESSED_OUTPUT or ENABLE_WRAP_AT_EOL_OUTPUT       );\r
14669       end\r
14670          else FConsoleOut := False;\r
14671     end\r
14672        else\r
14673       FreeConsole;\r
14674   end;\r
14675 \r
14676   LogOK;\r
14677   FINALLY\r
14678     Log( '<-TKOLProject.SetConsoleOut' );\r
14679   END;\r
14680 end;\r
14681 \r
14682 procedure TKOLProject.SetHelpFile(const Value: String);\r
14683 begin\r
14684   Log( '->TKOLProject.SetHelpFile' );\r
14685   TRY\r
14686 \r
14687   FHelpFile := Value;\r
14688   Change;\r
14689 \r
14690   LogOK;\r
14691   FINALLY\r
14692     Log( '<-TKOLProject.SetHelpFile' );\r
14693   END;\r
14694 end;\r
14695 \r
14696 procedure TKOLProject.SetIsKOLProject(const Value: Boolean);\r
14697 begin\r
14698   asm\r
14699     jmp @@e_signature\r
14700     DB '#$signature$#', 0\r
14701     DB 'TKOLProject.SetIsKOLProject', 0\r
14702   @@e_signature:\r
14703   end;\r
14704   Log( '->TKOLProject.SetIsKOLProject' );\r
14705   TRY\r
14706 \r
14707   if not FLocked and not (csLoading in ComponentState) then\r
14708   begin\r
14709     if Value then\r
14710     begin\r
14711       GetIsKOLProject;\r
14712       if fIsKOL < 1 then\r
14713       begin\r
14714         ShowMessage( 'Your project is not yet converted to KOL-MCK. '+\r
14715                      'To convert it, change property projectDest of TKOLProject first, ' +\r
14716                      'and then drop TKOLForm (or change any TKOLForm property, if ' +\r
14717                      'it is already dropped). Then, open destination project and work ' +\r
14718                      'with it.' );\r
14719         LogOK;\r
14720         Exit;\r
14721       end;\r
14722     end\r
14723       else\r
14724     begin\r
14725       fIsKOL := 0;\r
14726       GetIsKOLProject;\r
14727     end;\r
14728   end;\r
14729 \r
14730   LogOK;\r
14731   FINALLY\r
14732     Log( '<-TKOLProject.SetIsKOLProject' );\r
14733   END;\r
14734 end;\r
14735 \r
14736 procedure TKOLProject.SetLocalizy(const Value: Boolean);\r
14737 begin\r
14738   Log( '->TKOLProject.SetLocalizy' );\r
14739   TRY\r
14740 \r
14741   FLocalizy := Value;\r
14742   Change;\r
14743 \r
14744   LogOK;\r
14745   FINALLY\r
14746     Log( '<-TKOLProject.SetLocalizy' );\r
14747   END;\r
14748 end;\r
14749 \r
14750 procedure TKOLProject.SetLocked(const Value: Boolean);\r
14751 var I: Integer;\r
14752 begin\r
14753   asm\r
14754     jmp @@e_signature\r
14755     DB '#$signature$#', 0\r
14756     DB 'TKOLProject.SetLocked', 0\r
14757   @@e_signature:\r
14758   end;\r
14759   Log( '->TKOLProject.SetLocked' );\r
14760   TRY\r
14761 \r
14762   if FLocked = Value then\r
14763   begin\r
14764     LogOK;\r
14765     Exit;\r
14766   end;\r
14767   if not Value then\r
14768   begin\r
14769     for I := 0 to Owner.ComponentCount-1 do\r
14770       if IsVCLControl( Owner.Components[ I ] ) then\r
14771       begin\r
14772         ShowMessage( 'Form ' + Owner.Name + ' contains VCL controls. TKOLProject ' +\r
14773                      'component can not be unlocked.' );\r
14774         LogOK;\r
14775         Exit;\r
14776       end;\r
14777     I := MessageBox( 0, 'TKOLProject component was locked because one of project''s form had ' +\r
14778          'VCL controls placed on it. Are You sure You want to unlock TKOLProject?'#13 +\r
14779          '(Note: if the the project is VCL-based, unlocking TKOLProject ' +\r
14780          'component can damage it).', 'CAUTION!', MB_YESNO or MB_SETFOREGROUND );\r
14781     if I = ID_NO then\r
14782     begin\r
14783       LogOK;\r
14784       Exit;\r
14785     end;\r
14786   end;\r
14787   FLocked := Value;\r
14788 \r
14789   LogOK;\r
14790   FINALLY\r
14791     Log( '<-TKOLProject.SetLocked' );\r
14792   END;\r
14793 end;\r
14794 \r
14795 procedure TKOLProject.SetName(const NewName: TComponentName);\r
14796 var I: Integer;\r
14797     C: TComponent;\r
14798 begin\r
14799   asm\r
14800     jmp @@e_signature\r
14801     DB '#$signature$#', 0\r
14802     DB 'TKOLProject.SetName', 0\r
14803   @@e_signature:\r
14804   end;\r
14805   Log( '->TKOLProject.SetName' );\r
14806   TRY\r
14807 \r
14808   inherited;\r
14809   if not (csLoading in ComponentState) then\r
14810   if Owner <> nil then\r
14811   if Owner is TForm then\r
14812   if IsKOLProject then\r
14813   begin\r
14814     for I := 0 to (Owner as TForm).ComponentCount-1 do\r
14815     begin\r
14816       C := (Owner as TForm).Components[ I ];\r
14817       if C is TKOLForm then\r
14818       begin\r
14819         Build := TRUE;\r
14820         break;\r
14821       end;\r
14822     end;\r
14823   end;\r
14824 \r
14825   LogOK;\r
14826   FINALLY\r
14827     Log( '<-TKOLProject.SetName' );\r
14828   END;\r
14829 end;\r
14830 \r
14831 procedure TKOLProject.SetOutdcuPath(const Value: TFileName);\r
14832 begin\r
14833   asm\r
14834     jmp @@e_signature\r
14835     DB '#$signature$#', 0\r
14836     DB 'TKOLProject.SetOutdcuPath', 0\r
14837   @@e_signature:\r
14838   end;\r
14839   Log( '->TKOLProject.SetOutdcuPath' );\r
14840   TRY\r
14841     fOutdcuPath := ''; //TODO: understand what is it...\r
14842     //if FLocked then Exit;\r
14843   LogOK;\r
14844   FINALLY\r
14845     Log( '<-TKOLProject.SetOutdcuPath' );\r
14846   END;\r
14847 end;\r
14848 \r
14849 procedure TKOLProject.SetPaintType(const Value: TPaintType);\r
14850 begin\r
14851   asm\r
14852     jmp @@e_signature\r
14853     DB '#$signature$#', 0\r
14854     DB 'TKOLProject.SetPaintType', 0\r
14855   @@e_signature:\r
14856   end;\r
14857   Log( '->TKOLProject.SetPaintType' );\r
14858   TRY\r
14859 \r
14860   if FPaintType = Value then\r
14861   begin\r
14862     LogOK; Exit;\r
14863   end;\r
14864   FPaintType := Value;\r
14865   BroadCastPaintTypeToAllForms;\r
14866 \r
14867   LogOK;\r
14868   FINALLY\r
14869     Log( '<-TKOLProject.SetPaintType' );\r
14870   END;\r
14871 end;\r
14872 \r
14873 procedure TKOLProject.SetProjectDest(const Value: String);\r
14874 begin\r
14875   asm\r
14876     jmp @@e_signature\r
14877     DB '#$signature$#', 0\r
14878     DB 'TKOLProject.SetProjectDest', 0\r
14879   @@e_signature:\r
14880   end;\r
14881   Log( '->TKOLProject.SetProjectDest' );\r
14882   TRY\r
14883 \r
14884   if not FLocked then\r
14885   begin\r
14886     if not IsValidIdent( Value ) then\r
14887       ShowMessage( 'Destination project name must be valid identifier.' )\r
14888     else\r
14889     if (ProjectName = '') or (LowerCase( Value ) <> LowerCase( ProjectName )) then\r
14890       FProjectDest := Value;\r
14891   end;\r
14892 \r
14893   LogOK;\r
14894   FINALLY\r
14895     Log( '<-TKOLProject.SetProjectDest' );\r
14896   END;\r
14897 end;\r
14898 \r
14899 procedure TKOLProject.SetShowHint(const Value: Boolean);\r
14900 begin\r
14901   Log( '->TKOLProject.SetShowHint' );\r
14902   TRY\r
14903 \r
14904   FShowHint := Value;\r
14905   Change;\r
14906 \r
14907   LogOK;\r
14908   FINALLY\r
14909     Log( '<-TKOLProject.SetShowHint' );\r
14910   END;\r
14911 end;\r
14912 \r
14913 procedure TKOLProject.SetSupportAnsiMnemonics(const Value: LCID);\r
14914 begin\r
14915   asm\r
14916     jmp @@e_signature\r
14917     DB '#$signature$#', 0\r
14918     DB 'TKOLProject.SetSupportAnsiMnemonics', 0\r
14919   @@e_signature:\r
14920   end;\r
14921   Log( '->TKOLProject.SetSupportAnsiMnemonics' );\r
14922   TRY\r
14923     FSupportAnsiMnemonics := Value;\r
14924     Change;\r
14925   LogOK;\r
14926   FINALLY\r
14927     Log( '<-TKOLProject.SetSupportAnsiMnemonics' );\r
14928   END;\r
14929 end;\r
14930 \r
14931 function TKOLProject.StringConstant(const Propname, Value: String): String;\r
14932 begin\r
14933   Log( '->TKOLProject.StringConstant' );\r
14934   TRY\r
14935 \r
14936   if Localizy and (Value <> '') then\r
14937   begin\r
14938     Result := Name + '_' + Propname;\r
14939     MakeResourceString( Result, Value );\r
14940   end\r
14941     else\r
14942   begin\r
14943     Result := String2Pascal( Value );\r
14944   end;\r
14945 \r
14946   LogOK;\r
14947   FINALLY\r
14948     Log( '<-TKOLProject.StringConstant' );\r
14949   END;\r
14950 end;\r
14951 \r
14952 procedure TKOLProject.TimerTick( Sender: TObject );\r
14953 begin\r
14954   asm\r
14955     jmp @@e_signature\r
14956     DB '#$signature$#', 0\r
14957     DB 'TKOLProject.TimerTick', 0\r
14958   @@e_signature:\r
14959   end;\r
14960   Log( '->TKOLProject.TimerTick' );\r
14961   TRY\r
14962 \r
14963   //ShowMessage( 'Tick-Tack!' );\r
14964   fTimer.Enabled := False;\r
14965   if not FLocked then\r
14966   begin\r
14967     if AutoBuild then\r
14968     begin\r
14969       AutoBuilding := True;\r
14970       ConvertVCL2KOL( FALSE );\r
14971       AutoBuilding := False;\r
14972     end;\r
14973   end;\r
14974 \r
14975   LogOK;\r
14976   FINALLY\r
14977     Log( '<-TKOLProject.TimerTick' );\r
14978   END;\r
14979 end;\r
14980 \r
14981 function TKOLProject.UpdateConfig: Boolean;\r
14982 var S, R: String;\r
14983     L: TStringList;\r
14984     I: Integer;\r
14985     AFound, DFound {, DWere}: Boolean;\r
14986     Updated: Boolean;\r
14987 begin\r
14988   asm\r
14989     jmp @@e_signature\r
14990     DB '#$signature$#', 0\r
14991     DB 'TKOLProject.UpdateConfig', 0\r
14992   @@e_signature:\r
14993   end;\r
14994   Log( '->TKOLProject.UpdateConfig' );\r
14995   TRY\r
14996 \r
14997   Result := False;\r
14998   if not FLocked then\r
14999   begin\r
15000     S := SourcePath + ProjectName + '.cfg';\r
15001     R := SourcePath + ProjectDest + '.cfg';\r
15002     L := TStringList.Create;\r
15003     //DWere := FALSE;\r
15004     if FileExists( S ) then\r
15005     begin\r
15006       LoadSource( L, S );\r
15007       AFound := False;\r
15008       DFound := False;\r
15009       for I := 0 to L.Count - 1 do\r
15010       begin\r
15011         if Length( L[ I ] ) < 2 then continue;\r
15012         if L[ I ][ 2 ] = 'A' then\r
15013         begin\r
15014           L[ I ] := '-AClasses=;Controls=;mirror=';\r
15015           AFound := True;\r
15016         end;\r
15017         if L[ I ][ 2 ] = 'D' then\r
15018         begin\r
15019           {if pos( 'KOL_MCK', UpperCase( L[ I ] ) ) then\r
15020             DWere := TRUE;}\r
15021           if pos( 'KOL_MCK', UpperCase( L[ I ] ) ) <= 0 then\r
15022             L[ I ] := //'-DKOL_MCK';\r
15023                       IncludeTrailingChar( L[ I ], ';' ) + 'KOL_MCK';\r
15024           DFound := True;\r
15025         end;\r
15026       end;\r
15027       if not AFound then\r
15028         L.Add( '-AClasses=;Controls=;StdCtrls=;ExtCtrls=;mirror=' );\r
15029       if not DFound then\r
15030         L.Add( '-DKOL_MCK' );\r
15031       SaveStrings( L, R, Updated );\r
15032     end;\r
15033     L.Clear;\r
15034     S := SourcePath + ProjectName + '.dof';\r
15035     R := SourcePath + ProjectDest + '.dof';\r
15036     if FileExists( S ) then\r
15037     begin\r
15038       LoadSource( L, S );\r
15039       for I := 0 to L.Count - 1 do\r
15040       begin\r
15041         if Copy( L[ I ], 1, Length( 'UnitAliases=' ) ) = 'UnitAliases=' then\r
15042           L[ I ] := 'UnitAliases=Classes=;mirror=';\r
15043         if Copy( L[ I ], 1, Length( 'Conditionals=' ) ) = 'Conditionals=' then\r
15044         if pos( 'KOL_MCK', UpperCase( L[ I ] ) ) <= 0 then\r
15045           L[ I ] := 'Conditionals=KOL_MCK';\r
15046       end;\r
15047       SaveStrings( L, R, Updated );\r
15048     end;\r
15049     L.Free;\r
15050   end;\r
15051   LogOK;\r
15052   FINALLY\r
15053     Log( '<-TKOLProject.UpdateConfig' );\r
15054   END;\r
15055 end;\r
15056 \r
15057 { TFormBounds }\r
15058 \r
15059 procedure TFormBounds.Change;\r
15060 begin\r
15061   asm\r
15062     jmp @@e_signature\r
15063     DB '#$signature$#', 0\r
15064     DB 'TFormBounds.Change', 0\r
15065   @@e_signature:\r
15066   end;\r
15067   fL := Left;\r
15068   fT := Top;\r
15069   fH := Height;\r
15070   fW := Width;\r
15071   (Owner as TKOLForm).Change( nil );\r
15072   if not (csLoading in (Owner as TKOLForm).ComponentState) then\r
15073     (Owner as TKOLForm).AlignChildren( nil, FALSE );\r
15074 end;\r
15075 \r
15076 procedure TFormBounds.CheckFormSize(Sender: TObject);\r
15077 begin\r
15078   asm\r
15079     jmp @@e_signature\r
15080     DB '#$signature$#', 0\r
15081     DB 'TFormBounds.CheckFormSize', 0\r
15082   @@e_signature:\r
15083   end;\r
15084   if Owner = nil then Exit;\r
15085   //if Owner.Name = '' then Exit;\r
15086   if Owner.Owner = nil then Exit;\r
15087   //if Owner.Owner.Name = '' then Exit;\r
15088   if csLoading in (Owner as TComponent).ComponentState then Exit;\r
15089   if csLoading in (Owner.Owner as TComponent).ComponentState then Exit;\r
15090   if fL = (Owner.Owner as TForm).Left then\r
15091   if fT = (Owner.Owner as TForm).Top then\r
15092   if fW = (Owner.Owner as TForm).Width then\r
15093   if fH = (Owner.Owner as TForm).Height then Exit;\r
15094   {Rpt( 'L=' + IntToStr( fL ) + ' <> ' + IntToStr( (Owner.Owner as TForm).Left ) + #13#10 +\r
15095        'T=' + IntToStr( fT ) + ' <> ' + IntToStr( (Owner.Owner as TForm).Top ) + #13#10 +\r
15096        'W=' + IntToStr( fW ) + ' <> ' + IntToStr( (Owner.Owner as TForm).Width ) + #13#10 +\r
15097        'H=' + IntToStr( fH ) + ' <> ' + IntToStr( (Owner.Owner as TForm).Height ) + #13#10 );}\r
15098   Change;\r
15099 end;\r
15100 \r
15101 constructor TFormBounds.Create;\r
15102 begin\r
15103   asm\r
15104     jmp @@e_signature\r
15105     DB '#$signature$#', 0\r
15106     DB 'TFormBounds.Create', 0\r
15107   @@e_signature:\r
15108   end;\r
15109   inherited;\r
15110   fTimer := TTimer.Create( Owner );\r
15111   fTimer.Interval := 300;\r
15112   fTimer.OnTimer := CheckFormSize;\r
15113   fTimer.Enabled := FALSE;\r
15114 end;\r
15115 \r
15116 destructor TFormBounds.Destroy;\r
15117 begin\r
15118   asm\r
15119     jmp @@e_signature\r
15120     DB '#$signature$#', 0\r
15121     DB 'TFormBounds.Destroy', 0\r
15122   @@e_signature:\r
15123   end;\r
15124   if Assigned( fTimer ) then\r
15125   begin\r
15126     fTimer.Enabled := False;\r
15127     fTimer.Free;\r
15128     fTimer := nil;\r
15129   end;\r
15130   inherited;\r
15131 end;\r
15132 \r
15133 procedure TFormBounds.EnableTimer(Value: Boolean);\r
15134 begin\r
15135   fTimer.Enabled := Value;\r
15136 end;\r
15137 \r
15138 function TFormBounds.GetHeight: Integer;\r
15139 var F: TControl;\r
15140 begin\r
15141   asm\r
15142     jmp @@e_signature\r
15143     DB '#$signature$#', 0\r
15144     DB 'TFormBounds.GetHeight', 0\r
15145   @@e_signature:\r
15146   end;\r
15147   F := Owner.Owner as TControl;\r
15148   Result := F.Height;\r
15149 end;\r
15150 \r
15151 function TFormBounds.GetLeft: Integer;\r
15152 var F: TControl;\r
15153 begin\r
15154   asm\r
15155     jmp @@e_signature\r
15156     DB '#$signature$#', 0\r
15157     DB 'TFormBounds.GetLeft', 0\r
15158   @@e_signature:\r
15159   end;\r
15160   F := Owner.Owner as TControl;\r
15161   Result := F.Left;\r
15162 end;\r
15163 \r
15164 function TFormBounds.GetTop: Integer;\r
15165 var F: TControl;\r
15166 begin\r
15167   asm\r
15168     jmp @@e_signature\r
15169     DB '#$signature$#', 0\r
15170     DB 'TFormBounds.GetTop', 0\r
15171   @@e_signature:\r
15172   end;\r
15173   F := Owner.Owner as TControl;\r
15174   Result := F.Top;\r
15175 end;\r
15176 \r
15177 function TFormBounds.GetWidth: Integer;\r
15178 var F: TControl;\r
15179 begin\r
15180   asm\r
15181     jmp @@e_signature\r
15182     DB '#$signature$#', 0\r
15183     DB 'TFormBounds.GetWidth', 0\r
15184   @@e_signature:\r
15185   end;\r
15186   F := Owner.Owner as TControl;\r
15187   Result := F.Width;\r
15188 end;\r
15189 \r
15190 procedure TFormBounds.SetHeight(const Value: Integer);\r
15191 var F: TControl;\r
15192 begin\r
15193   asm\r
15194     jmp @@e_signature\r
15195     DB '#$signature$#', 0\r
15196     DB 'TFormBounds.SetHeight', 0\r
15197   @@e_signature:\r
15198   end;\r
15199   fH := Value;\r
15200   F := Owner.Owner as TControl;\r
15201   F.Height := Value;\r
15202   Change;\r
15203 end;\r
15204 \r
15205 procedure TFormBounds.SetLeft(const Value: Integer);\r
15206 var F: TControl;\r
15207 begin\r
15208   asm\r
15209     jmp @@e_signature\r
15210     DB '#$signature$#', 0\r
15211     DB 'TFormBounds.SetLeft', 0\r
15212   @@e_signature:\r
15213   end;\r
15214   fL := Value;\r
15215   F := Owner.Owner as TControl;\r
15216   F.Left := Value;\r
15217   Change;\r
15218 end;\r
15219 \r
15220 procedure TFormBounds.SetOwner(const Value: TComponent);\r
15221 begin\r
15222   fOwner := Value;\r
15223   if fOwner <> nil then\r
15224   if not(csLoading in fOwner.ComponentState) then\r
15225     fTimer.Enabled := True;\r
15226 end;\r
15227 \r
15228 procedure TFormBounds.SetTop(const Value: Integer);\r
15229 var F: TControl;\r
15230 begin\r
15231   asm\r
15232     jmp @@e_signature\r
15233     DB '#$signature$#', 0\r
15234     DB 'TFormBounds.SetTop', 0\r
15235   @@e_signature:\r
15236   end;\r
15237   fT := Value;\r
15238   F := Owner.Owner as TControl;\r
15239   F.Top := Value;\r
15240   Change;\r
15241 end;\r
15242 \r
15243 procedure TFormBounds.SetWidth(const Value: Integer);\r
15244 var F: TControl;\r
15245 begin\r
15246   asm\r
15247     jmp @@e_signature\r
15248     DB '#$signature$#', 0\r
15249     DB 'TFormBounds.SetWidth', 0\r
15250   @@e_signature:\r
15251   end;\r
15252   fW := Value;\r
15253   F := Owner.Owner as TControl;\r
15254   F.Width := Value;\r
15255   Change;\r
15256 end;\r
15257 \r
15258 { TKOLObj }\r
15259 \r
15260 function TKOLObj.AdditionalUnits: String;\r
15261 begin\r
15262   asm\r
15263     jmp @@e_signature\r
15264     DB '#$signature$#', 0\r
15265     DB 'TKOLObj.AdditionalUnits', 0\r
15266   @@e_signature:\r
15267   end;\r
15268   Result := '';\r
15269 end;\r
15270 \r
15271 procedure TKOLObj.AddToNotifyList(Sender: TComponent);\r
15272 begin\r
15273   asm\r
15274     jmp @@e_signature\r
15275     DB '#$signature$#', 0\r
15276     DB 'TKOLObj.AddToNotifyList', 0\r
15277   @@e_signature:\r
15278   end;\r
15279   if Assigned( fNotifyList ) then\r
15280   if fNotifyList.IndexOf( Sender ) < 0 then\r
15281     fNotifyList.Add( Sender );\r
15282 end;\r
15283 \r
15284 procedure TKOLObj.AssignEvents(SL: TStringList; const AName: String);\r
15285 begin\r
15286   asm\r
15287     jmp @@e_signature\r
15288     DB '#$signature$#', 0\r
15289     DB 'TKOLObj.AssignEvents', 0\r
15290   @@e_signature:\r
15291   end;\r
15292   DoAssignEvents( SL, AName,\r
15293   [ 'OnDestroy' ],\r
15294   [ @ OnDestroy ] );\r
15295 end;\r
15296 \r
15297 function TKOLObj.BestEventName: String;\r
15298 begin\r
15299   asm\r
15300     jmp @@e_signature\r
15301     DB '#$signature$#', 0\r
15302     DB 'TKOLObj.BestEventName', 0\r
15303   @@e_signature:\r
15304   end;\r
15305   Result := '';\r
15306 end;\r
15307 \r
15308 procedure TKOLObj.Change;\r
15309 begin\r
15310   asm\r
15311     jmp @@e_signature\r
15312     DB '#$signature$#', 0\r
15313     DB 'TKOLObj.Change', 0\r
15314   @@e_signature:\r
15315   end;\r
15316   if (csLoading in ComponentState) then Exit;\r
15317   if ParentKOLForm = nil then Exit;\r
15318   ParentKOLForm.Change( Self );\r
15319 end;\r
15320 \r
15321 function TKOLObj.CompareFirst(c, n: string): boolean;\r
15322 begin\r
15323   asm\r
15324     jmp @@e_signature\r
15325     DB '#$signature$#', 0\r
15326     DB 'TKOLObj.CompareFirst', 0\r
15327   @@e_signature:\r
15328   end;\r
15329   Result := FALSE;\r
15330 end;\r
15331 \r
15332 constructor TKOLObj.Create(AOwner: TComponent);\r
15333 begin\r
15334   asm\r
15335     jmp @@e_signature\r
15336     DB '#$signature$#', 0\r
15337     DB 'TKOLObj.Create', 0\r
15338   @@e_signature:\r
15339   end;\r
15340   fNotifyList := TList.Create;\r
15341   inherited;\r
15342   NeedFree := True;\r
15343 end;\r
15344 \r
15345 destructor TKOLObj.Destroy;\r
15346 var F: TKOLForm;\r
15347     I: Integer;\r
15348     C: TComponent;\r
15349 begin\r
15350   asm\r
15351     jmp @@e_signature\r
15352     DB '#$signature$#', 0\r
15353     DB 'TKOLObj.Destroy', 0\r
15354   @@e_signature:\r
15355   end;\r
15356   if Assigned( Owner ) and not (csDestroying in Owner.ComponentState) then\r
15357   if Assigned( fNotifyList ) then\r
15358     for I := fNotifyList.Count-1 downto 0 do\r
15359     begin\r
15360       C := fNotifyList[ I ];\r
15361       if C is TKOLObj then\r
15362         (C as TKOLObj).NotifyLinkedComponent( Self, noRemoved )\r
15363       else\r
15364       if C is TKOLCustomControl then\r
15365         (C as TKOLCustomControl).NotifyLinkedComponent( Self, noRemoved );\r
15366     end;\r
15367   fNotifyList.Free;\r
15368   fNotifyList := nil;\r
15369   F := ParentKOLForm;\r
15370   inherited;\r
15371   if F <> nil then\r
15372     F.Change( F );\r
15373 end;\r
15374 \r
15375 procedure TKOLObj.DoAssignEvents(SL: TStringList; const AName: String;\r
15376   EventNames: array of PChar; EventHandlers: array of Pointer);\r
15377 var I: Integer;\r
15378 begin\r
15379   asm\r
15380     jmp @@e_signature\r
15381     DB '#$signature$#', 0\r
15382     DB 'TKOLObj.DoAssignEvents', 0\r
15383   @@e_signature:\r
15384   end;\r
15385   for I := 0 to High( EventHandlers ) do\r
15386   begin\r
15387     if EventHandlers[ I ] <> nil then\r
15388     begin\r
15389       SL.Add( '      ' + AName + '.' + EventNames[ I ] + ' := Result.' +\r
15390               ParentForm.MethodName( EventHandlers[ I ] ) + ';' );\r
15391     end;\r
15392   end;\r
15393 end;\r
15394 \r
15395 procedure TKOLObj.FirstCreate;\r
15396 begin\r
15397   asm\r
15398     jmp @@e_signature\r
15399     DB '#$signature$#', 0\r
15400     DB 'TKOLObj.FirstCreate', 0\r
15401   @@e_signature:\r
15402   end;\r
15403 end;\r
15404 \r
15405 procedure TKOLObj.DoGenerateConstants( SL: TStringList );\r
15406 begin\r
15407   //\r
15408 end;\r
15409 \r
15410 function TKOLObj.Get_Tag: Integer;\r
15411 begin\r
15412   asm\r
15413     jmp @@e_signature\r
15414     DB '#$signature$#', 0\r
15415     DB 'TKOLObj.Get_Tag', 0\r
15416   @@e_signature:\r
15417   end;\r
15418   Result := F_Tag;\r
15419 end;\r
15420 \r
15421 function TKOLObj.NotAutoFree: Boolean;\r
15422 begin\r
15423   asm\r
15424     jmp @@e_signature\r
15425     DB '#$signature$#', 0\r
15426     DB 'TKOLObj.NotAutoFree', 0\r
15427   @@e_signature:\r
15428   end;\r
15429   Result := not NeedFree;\r
15430 end;\r
15431 \r
15432 procedure TKOLObj.NotifyLinkedComponent(Sender: TObject;\r
15433   Operation: TNotifyOperation);\r
15434 begin\r
15435   asm\r
15436     jmp @@e_signature\r
15437     DB '#$signature$#', 0\r
15438     DB 'TKOLObj.NotifyLinkedComponent', 0\r
15439   @@e_signature:\r
15440   end;\r
15441   if Operation = noRemoved then\r
15442   if Assigned( fNotifyList ) then\r
15443     fNotifyList.Remove( Sender );\r
15444 end;\r
15445 \r
15446 function TKOLObj.ParentForm: TForm;\r
15447 var C: TComponent;\r
15448 begin\r
15449   asm\r
15450     jmp @@e_signature\r
15451     DB '#$signature$#', 0\r
15452     DB 'TKOLObj.ParentForm', 0\r
15453   @@e_signature:\r
15454   end;\r
15455   C := Owner;\r
15456   while (C <> nil) and not(C is TForm) do\r
15457     C := C.Owner;\r
15458   Result := nil;\r
15459   if C <> nil then\r
15460   if C is TForm then\r
15461     Result := C as TForm;\r
15462 end;\r
15463 \r
15464 function TKOLObj.ParentKOLForm: TKOLForm;\r
15465 var C, D: TComponent;\r
15466     I: Integer;\r
15467 begin\r
15468   asm\r
15469     jmp @@e_signature\r
15470     DB '#$signature$#', 0\r
15471     DB 'TKOLObj.ParentKOLForm', 0\r
15472   @@e_signature:\r
15473   end;\r
15474   C := Owner;\r
15475   while (C <> nil) and not(C is TForm) do\r
15476     C := C.Owner;\r
15477   Result := nil;\r
15478   if C <> nil then\r
15479   if C is TForm then\r
15480   begin\r
15481     for I := 0 to (C as TForm).ComponentCount - 1 do\r
15482     begin\r
15483       D := (C as TForm).Components[ I ];\r
15484       if D is TKOLForm then\r
15485       begin\r
15486         Result := D as TKOLForm;\r
15487         break;\r
15488       end;\r
15489     end;\r
15490   end;\r
15491 end;\r
15492 \r
15493 procedure TKOLObj.SetName(const NewName: TComponentName);\r
15494 var OldName, NameNew: String;\r
15495     I, N: Integer;\r
15496     Success: Boolean;\r
15497 begin\r
15498   asm\r
15499     jmp @@e_signature\r
15500     DB '#$signature$#', 0\r
15501     DB 'TKOLObj.SetName', 0\r
15502   @@e_signature:\r
15503   end;\r
15504   OldName := Name;\r
15505   inherited SetName( NewName );\r
15506   if (Copy( NewName, 1, 3 ) = 'KOL') and (OldName = '') then\r
15507   begin\r
15508     NameNew := Copy( NewName, 4, Length( NewName ) - 3 );\r
15509     Success := True;\r
15510     if Owner <> nil then\r
15511     while Owner.FindComponent( NameNew ) <> nil do\r
15512     begin\r
15513       Success := False;\r
15514       for I := 1 to Length( NameNew ) do\r
15515       begin\r
15516         if NameNew[ I ] in [ '0'..'9' ] then\r
15517         begin\r
15518           Success := True;\r
15519           N := StrToInt( Copy( NameNew, I, Length( NameNew ) - I + 1 ) );\r
15520           Inc( N );\r
15521           NameNew := Copy( NameNew, 1, I - 1 ) + IntToStr( N );\r
15522           break;\r
15523         end;\r
15524       end;\r
15525       if not Success then break;\r
15526     end;\r
15527     if Success then\r
15528       Name := NameNew;\r
15529     if not (csLoading in ComponentState) then\r
15530       FirstCreate;\r
15531   end;\r
15532   Change;\r
15533 end;\r
15534 \r
15535 procedure TKOLObj.SetOnDestroy(const Value: TOnEvent);\r
15536 begin\r
15537   asm\r
15538     jmp @@e_signature\r
15539     DB '#$signature$#', 0\r
15540     DB 'TKOLObj.SetOnDestroy', 0\r
15541   @@e_signature:\r
15542   end;\r
15543   FOnDestroy := Value;\r
15544   Change;\r
15545 end;\r
15546 \r
15547 procedure TKOLObj.SetupFirst(SL: TStringList; const AName,\r
15548   AParent, Prefix: String);\r
15549 begin\r
15550   asm\r
15551     jmp @@e_signature\r
15552     DB '#$signature$#', 0\r
15553     DB 'TKOLObj.SetupFirst', 0\r
15554   @@e_signature:\r
15555   end;\r
15556   SL.Add( Prefix + AName + ' := New' + TypeName + ';' );\r
15557   GenerateTag( SL, AName, Prefix );\r
15558 end;\r
15559 \r
15560 procedure TKOLObj.SetupLast(SL: TStringList; const AName, AParent, Prefix: String);\r
15561 begin\r
15562   asm\r
15563     jmp @@e_signature\r
15564     DB '#$signature$#', 0\r
15565     DB 'TKOLObj.SetupLast', 0\r
15566   @@e_signature:\r
15567   end;\r
15568   // ïî óìîë÷àíèþ íè÷åãî íå íàäî... Ðàçâå òîëüêî â íàñëåäíèêàõ.\r
15569 end;\r
15570 \r
15571 function TKOLObj.TypeName: String;\r
15572 begin\r
15573   asm\r
15574     jmp @@e_signature\r
15575     DB '#$signature$#', 0\r
15576     DB 'TKOLObj.TypeName', 0\r
15577   @@e_signature:\r
15578   end;\r
15579   Result := ClassName;\r
15580   if UpperCase( Copy( Result, 1, 4 ) ) = 'TKOL' then\r
15581     Result := Copy( Result, 5, Length( Result ) - 4 );\r
15582 end;\r
15583 \r
15584 procedure TKOLObj.Set_Tag(const Value: Integer);\r
15585 begin\r
15586   F_Tag := Value;\r
15587   Change;\r
15588 end;\r
15589 \r
15590 procedure TKOLObj.GenerateTag(SL: TStringList; const AName,\r
15591   APrefix: String);\r
15592 var S: String;\r
15593 begin\r
15594   if F_Tag <> 0 then\r
15595   begin\r
15596     S := IntToStr( F_Tag );\r
15597     if Integer( F_Tag ) < 0 then\r
15598       S := 'DWORD( ' + S + ' )';\r
15599     SL.Add( APrefix + AName + '.Tag := ' + S + ';' )\r
15600   end;\r
15601 end;\r
15602 \r
15603 function TKOLObj.StringConstant(const Propname, Value: String): String;\r
15604 begin\r
15605   if (Value <> '') AND\r
15606      ((Localizy = loForm) and (ParentKOLForm <> nil) and\r
15607      (ParentKOLForm.Localizy) or (Localizy = loYes)) then\r
15608   begin\r
15609     Result := ParentKOLForm.Name + '_' + Name + '_' + Propname;\r
15610     ParentKOLForm.MakeResourceString( Result, Value );\r
15611   end\r
15612     else\r
15613   begin\r
15614     Result := String2Pascal( Value );\r
15615   end;\r
15616 end;\r
15617 \r
15618 procedure TKOLObj.SetLocalizy(const Value: TLocalizyOptions);\r
15619 begin\r
15620   FLocalizy := Value;\r
15621   Change;\r
15622 end;\r
15623 \r
15624 function TKOLObj.OwnerKOLForm( AOwner: TComponent ): TKOLForm;\r
15625 var C, D: TComponent;\r
15626     I: Integer;\r
15627 begin\r
15628   asm\r
15629     jmp @@e_signature\r
15630     DB '#$signature$#', 0\r
15631     DB 'TKOLObj.ParentKOLForm', 0\r
15632   @@e_signature:\r
15633   end;\r
15634   C := AOwner;\r
15635   while (C <> nil) and not(C is TForm) do\r
15636     C := C.Owner;\r
15637   Result := nil;\r
15638   if C <> nil then\r
15639   if C is TForm then\r
15640   begin\r
15641     for I := 0 to (C as TForm).ComponentCount - 1 do\r
15642     begin\r
15643       D := (C as TForm).Components[ I ];\r
15644       if D is TKOLForm then\r
15645       begin\r
15646         Result := D as TKOLForm;\r
15647         break;\r
15648       end;\r
15649     end;\r
15650   end;\r
15651 end;\r
15652 \r
15653 procedure TKOLObj.DoNotifyLinkedComponents(Operation: TNotifyOperation);\r
15654 var I: Integer;\r
15655     C: TComponent;\r
15656 begin\r
15657   if Assigned( fNotifyList ) then\r
15658     for I := fNotifyList.Count-1 downto 0 do\r
15659     begin\r
15660       C := fNotifyList[ I ];\r
15661       if C is TKOLObj then\r
15662         (C as TKOLObj).NotifyLinkedComponent( Self, Operation )\r
15663       else\r
15664       if C is TKOLCustomControl then\r
15665         (C as TKOLCustomControl).NotifyLinkedComponent( Self, Operation );\r
15666     end;\r
15667 end;\r
15668 \r
15669 { TKOLFont }\r
15670 \r
15671 procedure TKOLFont.Assign(Value: TPersistent);\r
15672 var F: TKOLFont;\r
15673 begin\r
15674   asm\r
15675     jmp @@e_signature\r
15676     DB '#$signature$#', 0\r
15677     DB 'TKOLFont.Assign', 0\r
15678   @@e_signature:\r
15679   end;\r
15680   //inherited;\r
15681   if Value is TKOLFont then\r
15682   begin\r
15683     F := Value as TKOLFont;\r
15684     FColor := F.Color;\r
15685     //Rpt( '-------------------------------Assigned font color:' + Int2Hex( Color2RGB( F.Color ), 8 ) );\r
15686     FFontStyle := F.FontStyle;\r
15687     FFontHeight := F.FontHeight;\r
15688     FFontWidth := F.FontWidth;\r
15689     FFontWeight := F.FontWeight;\r
15690     FFontName := F.FontName;\r
15691     FFontOrientation := F.FontOrientation;\r
15692     FFontCharset := F.FontCharset;\r
15693     FFontPitch := F.FontPitch;\r
15694     Change;\r
15695   end;\r
15696 end;\r
15697 \r
15698 procedure TKOLFont.Change;\r
15699 var ParentOfOwner: TComponent;\r
15700     {$IFDEF _KOLCtrlWrapper_}\r
15701     _FKOLCtrl: PControl;\r
15702     {$ENDIF}\r
15703 begin\r
15704   asm\r
15705     jmp @@e_signature\r
15706     DB '#$signature$#', 0\r
15707     DB 'TKOLFont.Change', 0\r
15708   @@e_signature:\r
15709   end;\r
15710   if fOwner = nil then Exit;\r
15711   if csLoading in fOwner.ComponentState then Exit;\r
15712   if fChangingNow then Exit;\r
15713   try\r
15714 \r
15715     if fOwner is TKOLForm then\r
15716     begin\r
15717       (fOwner as TKOLForm).ApplyFontToChildren;\r
15718       (fOwner as TKOLForm).Change( fOwner );\r
15719     end\r
15720     else\r
15721     {if (fOwner is TKOLCustomControl) then\r
15722     begin\r
15723       if not (csLoading in fOwner.ComponentState) then\r
15724       begin\r
15725         ParentOfOwner := (fOwner as TKOLCustomControl).ParentKOLControl;\r
15726         if ParentOfOwner <> nil then\r
15727           if ParentOfOwner is TKolForm then\r
15728           begin\r
15729             if not Equal2( (ParentOfOwner as TKOLForm).Font ) then\r
15730               (fOwner as TKOLCustomControl).ParentFont := FALSE;\r
15731           end\r
15732             else\r
15733           if ParentOfOwner is TKOLCustomControl then\r
15734           begin\r
15735             if not Equal2( (ParentOfOwner as TKOLCustomControl).Font ) then\r
15736               (fOwner as TKOLCustomControl).ParentFont := FALSE;\r
15737           end;\r
15738       end;}\r
15739     ////////////////////////////////////////// changed by YS 11-Dec-2003\r
15740     if (fOwner is TKOLCustomControl) then\r
15741     begin\r
15742       ParentOfOwner := (fOwner as TKOLCustomControl).ParentKOLControl;\r
15743       if (ParentOfOwner <> nil) and not (csLoading in ParentOfOwner.ComponentState) then\r
15744         if ParentOfOwner is TKolForm then\r
15745         begin\r
15746           if not Equal2( (ParentOfOwner as TKOLForm).Font ) then\r
15747             (fOwner as TKOLCustomControl).ParentFont := FALSE;\r
15748         end\r
15749           else\r
15750         if ParentOfOwner is TKOLCustomControl then\r
15751         begin\r
15752           if not Equal2( (ParentOfOwner as TKOLCustomControl).Font ) then\r
15753             (fOwner as TKOLCustomControl).ParentFont := FALSE;\r
15754         end;\r
15755   //////////////////////////////////////////////////////////////////////////////\r
15756   {YS}\r
15757   {$IFDEF _KOLCtrlWrapper_}\r
15758       if Assigned((fOwner as TKOLCustomControl).FKOLCtrl) then\r
15759       begin\r
15760           _FKOLCtrl := (fOwner as TKOLCustomControl).FKOLCtrl;\r
15761           if not Equal2(nil) then\r
15762           begin\r
15763             _FKOLCtrl.Font.FontName:=FontName;\r
15764             _FKOLCtrl.Font.FontHeight:=FontHeight;\r
15765             _FKOLCtrl.Font.FontWidth:=FontWidth;\r
15766             _FKOLCtrl.Font.Color:=Self.Color;\r
15767             _FKOLCtrl.Font.FontStyle:= KOL.TFontStyle( FontStyle );\r
15768             {$IFNDEF _D2}\r
15769             _FKOLCtrl.Font.FontCharset:=FontCharset;\r
15770             {$ENDIF}\r
15771           end\r
15772           else\r
15773             _FKOLCtrl.Font.AssignHandle((fOwner as TKOLCustomControl).GetDefaultControlFont);\r
15774           (fOwner as TKOLCustomControl).Invalidate;\r
15775       end;\r
15776   {$ENDIF}\r
15777 {YS}\r
15778       (fOwner as TKOLCustomControl).ApplyFontToChildren;\r
15779       (fOwner as TKOLCustomControl).Change;\r
15780       (fOwner as TKOLCustomControl).Invalidate;\r
15781     end                               // correct by Gendalf\r
15782       else                            // +\r
15783         if (fOwner is TKOLObj) then   // +\r
15784           (fOwner as TKOLObj).Change; // +\r
15785 \r
15786   finally\r
15787     fChangingNow := FALSE;\r
15788   end;\r
15789 end;\r
15790 \r
15791 procedure TKOLFont.Changing;\r
15792 begin\r
15793   asm\r
15794     jmp @@e_signature\r
15795     DB '#$signature$#', 0\r
15796     DB 'TKOLFont.Changing', 0\r
15797   @@e_signature:\r
15798   end;\r
15799   if fOwner is TKOLForm then\r
15800     (fOwner as TKOLForm).CollectChildrenWithParentFont\r
15801   else\r
15802   if fOwner is TKOLCustomControl then\r
15803     (fOwner as TKOLCustomControl).CollectChildrenWithParentFont;\r
15804 end;\r
15805 \r
15806 constructor TKOLFont.Create(AOwner: TComponent);\r
15807 begin\r
15808   asm\r
15809     jmp @@e_signature\r
15810     DB '#$signature$#', 0\r
15811     DB 'TKOLFont.Create', 0\r
15812   @@e_signature:\r
15813   end;\r
15814   inherited Create;\r
15815   fOwner := AOwner;\r
15816   fColor := clWindowText;\r
15817   fFontName := 'MS Sans Serif';\r
15818   fFontWidth := 0;\r
15819   fFontHeight := 0;\r
15820   fFontCharset := DEFAULT_CHARSET;\r
15821   fFontPitch := fpDefault;\r
15822   FFontOrientation := 0;\r
15823   FFontWeight := 0;\r
15824   FFontStyle := [ ];\r
15825 end;\r
15826 \r
15827 function TKOLFont.Equal2(AFont: TKOLFont): Boolean;\r
15828 begin\r
15829   asm\r
15830     jmp @@e_signature\r
15831     DB '#$signature$#', 0\r
15832     DB 'TKOLFont.Equal2', 0\r
15833   @@e_signature:\r
15834   end;\r
15835   Result := False;\r
15836   if AFont = nil then\r
15837   begin\r
15838     if Color <> clWindowText then Exit;\r
15839     if FontStyle <> [ ] then Exit;\r
15840     if FontHeight <> 0 then Exit;\r
15841     if FontWidth <> 0 then Exit;\r
15842     if FontWeight <> 0 then Exit;\r
15843     if FontName <> 'MS Sans Serif' then Exit;\r
15844     if FontOrientation <> 0 then Exit;\r
15845     if FontCharset <> DEFAULT_CHARSET then Exit;\r
15846     if FontPitch <> fpDefault then Exit;\r
15847     Result := True;\r
15848     Exit;\r
15849   end;\r
15850   if Color <> AFont.Color then Exit;\r
15851   if FontStyle <> AFont.FontStyle then Exit;\r
15852   if FontHeight <> AFont.FontHeight then Exit;\r
15853   if FontWidth <> AFont.FontWidth then Exit;\r
15854   if FontWeight <> AFont.FontWeight then Exit;\r
15855   if FontName <> AFont.FontName then Exit;\r
15856   if FontOrientation <> AFont.FontOrientation then Exit;\r
15857   if FontCharset <> AFont.FontCharset then Exit;\r
15858   if FontPitch <> AFont.FontPitch then Exit;\r
15859   Result := True;\r
15860 end;\r
15861 \r
15862 procedure TKOLFont.GenerateCode(SL: TStrings; const AName: String;\r
15863   AFont: TKOLFont);\r
15864 const\r
15865   FontPitches: array[ TFontPitch ] of String = ( 'fpDefault', 'fpVariable', 'fpFixed' );\r
15866 var BFont: TKOLFont;\r
15867     S: String;\r
15868     FontPname: String;\r
15869     Lines: Integer;\r
15870 \r
15871     procedure AddLine( const S: String );\r
15872     begin\r
15873       if Lines = 0 then\r
15874         if (fOwner <> nil) and (fOwner is TKOLCustomControl) then\r
15875           (fOwner as TKOLCustomControl).BeforeFontChange( SL, AName, '    ' );\r
15876       Inc( Lines );\r
15877       //Rpt( AName + '.' + FontPname + '.' + S + ';' );\r
15878       SL.Add( '    ' + AName + '.' + FontPname + '.' + S + ';' );\r
15879     end;\r
15880 \r
15881 begin\r
15882   asm\r
15883     jmp @@e_signature\r
15884     DB '#$signature$#', 0\r
15885     DB 'TKOLFont.GenerateCode', 0\r
15886   @@e_signature:\r
15887   end;\r
15888   //Rpt( fOwner.Name );\r
15889   BFont := AFont;\r
15890   if AFont = nil then\r
15891     BFont := TKOLFont.Create( nil );\r
15892 \r
15893   FontPname := 'Font';\r
15894   Lines := 0;\r
15895   if (fOwner <> nil) and (fOwner is TKOLCustomControl) then\r
15896     FontPname := (fOwner as TKOLCustomControl).FontPropName;\r
15897 \r
15898   if Color <> BFont.Color then\r
15899     AddLine( 'Color := ' + Color2Str( Color ) );\r
15900   if FontStyle <> BFont.FontStyle then\r
15901   begin\r
15902     S := '';\r
15903     if fsBold in TFontStyles( FontStyle ) then\r
15904       S := ' fsBold,';\r
15905     if fsItalic in TFontStyles( FontStyle ) then\r
15906       S := S + ' fsItalic,';\r
15907     if fsStrikeout in TFontStyles( FontStyle ) then\r
15908       S := S + ' fsStrikeOut,';\r
15909     if fsUnderline in TFontStyles( FontStyle ) then\r
15910       S := S + ' fsUnderline,';\r
15911     if S <> '' then\r
15912       S := Trim( Copy( S, 1, Length( S ) - 1 ) );\r
15913     AddLine( 'FontStyle := [ ' + S + ' ]' );\r
15914   end;\r
15915   if FontHeight <> BFont.FontHeight then\r
15916     AddLine( 'FontHeight := ' + IntToStr( FontHeight ) );\r
15917   if FontWidth <> BFont.FontWidth then\r
15918     AddLine( 'FontWidth := ' + IntToStr( FontWidth ) );\r
15919   if FontName <> BFont.FontName then\r
15920     AddLine( 'FontName := ''' + FontName + '''' );\r
15921   if FontOrientation <> BFont.FontOrientation then\r
15922     AddLine( 'FontOrientation := ' + IntToStr( FontOrientation ) );\r
15923   if FontCharset <> BFont.FontCharset then\r
15924     AddLine( 'FontCharset := ' + IntToStr( FontCharset ) );\r
15925   if FontPitch <> BFont.FontPitch then\r
15926     AddLine( 'FontPitch := ' + FontPitches[ FontPitch ] );\r
15927 \r
15928   if AFont = nil then\r
15929     BFont.Free;\r
15930 \r
15931   if Lines > 0 then\r
15932   if (fOwner <> nil) and (fOwner is TKOLCustomControl) then\r
15933     (fOwner as TKOLCustomControl).AfterFontChange( SL, AName, '    ' );\r
15934 end;\r
15935 \r
15936 procedure TKOLFont.SetColor(const Value: TColor);\r
15937 begin\r
15938   asm\r
15939     jmp @@e_signature\r
15940     DB '#$signature$#', 0\r
15941     DB 'TKOLFont.SetColor', 0\r
15942   @@e_signature:\r
15943   end;\r
15944   if FColor = Value then Exit;\r
15945   if Value <> clWindowText then\r
15946   begin\r
15947     if Assigned( fOwner ) then\r
15948     if fOwner is TKOLCustomControl then\r
15949     if (fOwner as TKOLCustomControl).CanNotChangeFontColor then\r
15950     begin\r
15951       ShowMessage( 'Can not change font color for some of controls, such as button.' );\r
15952       Exit;\r
15953     end;\r
15954   end;\r
15955   Changing;\r
15956   FColor := Value;\r
15957   Change;\r
15958 end;\r
15959 \r
15960 procedure TKOLFont.SetFontCharset(const Value: Byte);\r
15961 begin\r
15962   asm\r
15963     jmp @@e_signature\r
15964     DB '#$signature$#', 0\r
15965     DB 'TKOLFont.SetFontCharset', 0\r
15966   @@e_signature:\r
15967   end;\r
15968   if FFontCharset = Value then Exit;\r
15969   Changing;\r
15970   FFontCharset := Value;\r
15971   Change;\r
15972 end;\r
15973 \r
15974 procedure TKOLFont.SetFontHeight(const Value: Integer);\r
15975 begin\r
15976   asm\r
15977     jmp @@e_signature\r
15978     DB '#$signature$#', 0\r
15979     DB 'TKOLFont.SetFontHeight', 0\r
15980   @@e_signature:\r
15981   end;\r
15982   if FFontHeight = Value then Exit;\r
15983   Changing;\r
15984   FFontHeight := Value;\r
15985   Change;\r
15986 end;\r
15987 \r
15988 procedure TKOLFont.SetFontName(const Value: String);\r
15989 begin\r
15990   asm\r
15991     jmp @@e_signature\r
15992     DB '#$signature$#', 0\r
15993     DB 'TKOLFont.SetFontName', 0\r
15994   @@e_signature:\r
15995   end;\r
15996   if FFontName = Value then Exit;\r
15997   Changing;\r
15998   FFontName := Value;\r
15999   Change;\r
16000 end;\r
16001 \r
16002 procedure TKOLFont.SetFontOrientation(Value: Integer);\r
16003 begin\r
16004   asm\r
16005     jmp @@e_signature\r
16006     DB '#$signature$#', 0\r
16007     DB 'TKOLFont.SetFontOrientation', 0\r
16008   @@e_signature:\r
16009   end;\r
16010   if FFontOrientation = Value then Exit;\r
16011   Changing;\r
16012   if Value > 3600 then Value := 3600;\r
16013   if Value < -3600 then Value := -3600;\r
16014   FFontOrientation := Value;\r
16015   Change;\r
16016 end;\r
16017 \r
16018 procedure TKOLFont.SetFontPitch(const Value: TFontPitch);\r
16019 begin\r
16020   asm\r
16021     jmp @@e_signature\r
16022     DB '#$signature$#', 0\r
16023     DB 'TKOLFont.SetFontPitch', 0\r
16024   @@e_signature:\r
16025   end;\r
16026   if FFontPitch = Value then Exit;\r
16027   Changing;\r
16028   FFontPitch := Value;\r
16029   Change;\r
16030 end;\r
16031 \r
16032 procedure TKOLFont.SetFontStyle(const Value: TFontStyles);\r
16033 begin\r
16034   asm\r
16035     jmp @@e_signature\r
16036     DB '#$signature$#', 0\r
16037     DB 'TKOLFont.SetFontStyle', 0\r
16038   @@e_signature:\r
16039   end;\r
16040   if FFontStyle = Value then Exit;\r
16041   Changing;\r
16042   FFontStyle := Value;\r
16043   Change;\r
16044 end;\r
16045 \r
16046 procedure TKOLFont.SetFontWeight(Value: Integer);\r
16047 begin\r
16048   asm\r
16049     jmp @@e_signature\r
16050     DB '#$signature$#', 0\r
16051     DB 'TKOLFont.SetFontWeight', 0\r
16052   @@e_signature:\r
16053   end;\r
16054   if Value < 0 then Value := 0;\r
16055   if Value > 1000 then Value := 1000;\r
16056   if FFontWeight = Value then Exit;\r
16057   Changing;\r
16058   FFontWeight := Value;\r
16059   if Value > 0 then\r
16060     FFontStyle := FFontStyle + [ fsBold ]\r
16061   else\r
16062     FFontStyle := FFontStyle - [ fsBold ];\r
16063   Change;\r
16064 end;\r
16065 \r
16066 procedure TKOLFont.SetFontWidth(const Value: Integer);\r
16067 begin\r
16068   asm\r
16069     jmp @@e_signature\r
16070     DB '#$signature$#', 0\r
16071     DB 'TKOLFont.SetFontWidth', 0\r
16072   @@e_signature:\r
16073   end;\r
16074   if FFontWidth = Value then Exit;\r
16075   Changing;\r
16076   FFontWidth := Value;\r
16077   Change;\r
16078 end;\r
16079 \r
16080 { TKOLProjectBuilder }\r
16081 \r
16082 procedure TKOLProjectBuilder.Edit;\r
16083 begin\r
16084   asm\r
16085     jmp @@e_signature\r
16086     DB '#$signature$#', 0\r
16087     DB 'TKOLProjectBuilder.Edit', 0\r
16088   @@e_signature:\r
16089   end;\r
16090   if Component = nil then Exit;\r
16091   if not(Component is TKOLProject) then Exit;\r
16092   (Component as TKOLProject).SetBuild( True );\r
16093 end;\r
16094 \r
16095 procedure TKOLProjectBuilder.ExecuteVerb(Index: Integer);\r
16096 var SL: TStringList;\r
16097     S: String;\r
16098 begin\r
16099   asm\r
16100     jmp @@e_signature\r
16101     DB '#$signature$#', 0\r
16102     DB 'TKOLProjectBuilder.ExecuteVerb', 0\r
16103   @@e_signature:\r
16104   end;\r
16105   case Index of\r
16106   0: Edit;\r
16107   1: if Component <> nil then\r
16108      if Component is TKOLProject then\r
16109      TRY\r
16110        S := (Component as TKOLProject).sourcePath;\r
16111        ShellExecute( 0, nil, PChar( S ), nil, nil, SW_SHOW );\r
16112      EXCEPT on E: Exception do\r
16113          begin\r
16114            SL := TStringList.Create;\r
16115            TRY\r
16116              SL := GetCallStack;\r
16117              ShowMessage( 'Exception 13611: ' + E.Message + ' (' + S + ')' +\r
16118                           #13#10 + SL.Text );\r
16119            FINALLY\r
16120              SL.Free;\r
16121            END;\r
16122          end;\r
16123      END;\r
16124   end;\r
16125 end;\r
16126 \r
16127 function TKOLProjectBuilder.GetVerb(Index: Integer): string;\r
16128 begin\r
16129   asm\r
16130     jmp @@e_signature\r
16131     DB '#$signature$#', 0\r
16132     DB 'TKOLProjectBuilder.GetVerb', 0\r
16133   @@e_signature:\r
16134   end;\r
16135   case Index of\r
16136   0: Result := 'Convert to KOL';\r
16137   1: Result := 'Open project folder';\r
16138   end;\r
16139 end;\r
16140 \r
16141 function TKOLProjectBuilder.GetVerbCount: Integer;\r
16142 begin\r
16143   asm\r
16144     jmp @@e_signature\r
16145     DB '#$signature$#', 0\r
16146     DB 'TKOLProjectBuilder.GetVerbCount', 0\r
16147   @@e_signature:\r
16148   end;\r
16149   Result := 2;\r
16150 end;\r
16151 \r
16152 {$IFDEF _D5}\r
16153 { TLeftPropEditor }\r
16154 \r
16155 function TLeftPropEditor.VisualValue: string;\r
16156 var Comp: TPersistent;\r
16157 begin\r
16158   asm\r
16159     jmp @@e_signature\r
16160     DB '#$signature$#', 0\r
16161     DB 'TLeftPropEditor.VisualValue', 0\r
16162   @@e_signature:\r
16163   end;\r
16164   Result := Value;\r
16165   Comp := GetComponent( 0 );\r
16166   if Comp is TKOLCustomControl then\r
16167     Result := IntToStr( (Comp as TKOLCustomControl).actualLeft );\r
16168 end;\r
16169 \r
16170 procedure TLeftPropEditor.PropDrawValue(ACanvas: TCanvas;\r
16171   const ARect: TRect; ASelected: Boolean);\r
16172 begin\r
16173   asm\r
16174     jmp @@e_signature\r
16175     DB '#$signature$#', 0\r
16176     DB 'TLeftPropEditor.PropDrawValue', 0\r
16177   @@e_signature:\r
16178   end;\r
16179   ACanvas.Brush.Color := clBtnFace;\r
16180   ACanvas.Font.Color := clWindowText;\r
16181   if ASelected then\r
16182   begin\r
16183     ACanvas.Brush.Color := clHighLight;\r
16184     ACanvas.Font.Color := clHighlightText;\r
16185   end;\r
16186   ACanvas.TextRect( ARect, ARect.Left, ARect.Top, VisualValue );\r
16187 end;\r
16188 \r
16189 { TTopPropEditor }\r
16190 \r
16191 procedure TTopPropEditor.PropDrawValue(ACanvas: TCanvas;\r
16192   const ARect: TRect; ASelected: Boolean);\r
16193 begin\r
16194   asm\r
16195     jmp @@e_signature\r
16196     DB '#$signature$#', 0\r
16197     DB 'TTopPropEditor.PropDrawValue', 0\r
16198   @@e_signature:\r
16199   end;\r
16200   ACanvas.Brush.Color := clBtnFace;\r
16201   ACanvas.Font.Color := clWindowText;\r
16202   if ASelected then\r
16203   begin\r
16204     ACanvas.Brush.Color := clHighLight;\r
16205     ACanvas.Font.Color := clHighlightText;\r
16206   end;\r
16207   ACanvas.TextRect( ARect, ARect.Left, ARect.Top, VisualValue );\r
16208 end;\r
16209 \r
16210 function TTopPropEditor.VisualValue: string;\r
16211 var Comp: TPersistent;\r
16212 begin\r
16213   asm\r
16214     jmp @@e_signature\r
16215     DB '#$signature$#', 0\r
16216     DB 'TTopPropEditor.VisualValue', 0\r
16217   @@e_signature:\r
16218   end;\r
16219   Result := Value;\r
16220   Comp := GetComponent( 0 );\r
16221   if Comp is TKOLCustomControl then\r
16222     Result := IntToStr( (Comp as TKOLCustomControl).actualTop );\r
16223 end;\r
16224 {$ENDIF}\r
16225 \r
16226 { TKOLDataModule }\r
16227 \r
16228 procedure TKOLDataModule.GenerateAdd2AutoFree(SL: TStringList;\r
16229   const AName: String; AControl: Boolean; Add2AutoFreeProc: String; Obj: TObject);\r
16230 begin\r
16231   asm\r
16232     jmp @@e_signature\r
16233     DB '#$signature$#', 0\r
16234     DB 'TKOLDataModule.GenerateAdd2AutoFree', 0\r
16235   @@e_signature:\r
16236   end;\r
16237   if Obj <> nil then\r
16238   if Obj is TKOLObj then\r
16239   if (Obj as TKOLObj).NotAutoFree then\r
16240     Exit;\r
16241   if Add2AutoFreeProc = '' then\r
16242     Add2AutoFreeProc := 'Add2AutoFree';\r
16243   if AName <> 'Result' then\r
16244     SL.Add( '  Result.' + Add2AutoFreeProc + '( ' + AName + ' );' );\r
16245 end;\r
16246 \r
16247 procedure TKOLDataModule.GenerateCreateForm(SL: TStringList);\r
16248 begin\r
16249   asm\r
16250     jmp @@e_signature\r
16251     DB '#$signature$#', 0\r
16252     DB 'TKOLDataModule.GenerateCreateForm', 0\r
16253   @@e_signature:\r
16254   end;\r
16255   // do not generate - there are no form\r
16256 end;\r
16257 \r
16258 procedure TKOLDataModule.GenerateDestroyAfterRun(SL: TStringList);\r
16259 begin\r
16260   asm\r
16261     jmp @@e_signature\r
16262     DB '#$signature$#', 0\r
16263     DB 'TKOLDataModule.GenerateDestroyAfterRun', 0\r
16264   @@e_signature:\r
16265   end;\r
16266   if howToDestroy = ddAfterRun then\r
16267     SL.Add( '  ' + inherited FormName + '.Free;' );\r
16268 end;\r
16269 \r
16270 function TKOLDataModule.GenerateINC(const Path: String;\r
16271   var Updated: Boolean): Boolean;\r
16272 begin\r
16273   asm\r
16274     jmp @@e_signature\r
16275     DB '#$signature$#', 0\r
16276     DB 'TKOLDataModule.GenerateINC', 0\r
16277   @@e_signature:\r
16278   end;\r
16279   Result := inherited GenerateINC( Path, Updated );\r
16280 end;\r
16281 \r
16282 function TKOLDataModule.GenerateTransparentInits: String;\r
16283 begin\r
16284   asm\r
16285     jmp @@e_signature\r
16286     DB '#$signature$#', 0\r
16287     DB 'TKOLDataModule.GenerateTransparentInits', 0\r
16288   @@e_signature:\r
16289   end;\r
16290   Result := '';\r
16291 end;\r
16292 \r
16293 function TKOLDataModule.Result_Form: String;\r
16294 begin\r
16295   asm\r
16296     jmp @@e_signature\r
16297     DB '#$signature$#', 0\r
16298     DB 'TKOLDataModule.Result_Form', 0\r
16299   @@e_signature:\r
16300   end;\r
16301   Result := 'nil';\r
16302 end;\r
16303 \r
16304 procedure TKOLDataModule.SethowToDestroy(\r
16305   const Value: TDataModuleHowToDestroy);\r
16306 begin\r
16307   asm\r
16308     jmp @@e_signature\r
16309     DB '#$signature$#', 0\r
16310     DB 'TKOLDataModule.SethowToDestroy', 0\r
16311   @@e_signature:\r
16312   end;\r
16313   if Value = FhowToDestroy then Exit;\r
16314   FhowToDestroy := Value;\r
16315   Change( Self );\r
16316   if not (csLoading in ComponentState) then\r
16317     ChangeDPR;\r
16318 end;\r
16319 \r
16320 procedure TKOLDataModule.SetOnCreate(const Value: TOnEvent);\r
16321 begin\r
16322   asm\r
16323     jmp @@e_signature\r
16324     DB '#$signature$#', 0\r
16325     DB 'TKOLDataModule.SetOnCreate', 0\r
16326   @@e_signature:\r
16327   end;\r
16328   FOnCreate := Value;\r
16329   Change( Self );\r
16330 end;\r
16331 \r
16332 procedure TKOLDataModule.SetupFirst(SL: TStringList; const AName, AParent,\r
16333   Prefix: String);\r
16334 begin\r
16335   asm\r
16336     jmp @@e_signature\r
16337     DB '#$signature$#', 0\r
16338     DB 'TKOLDataModule.SetupFirst', 0\r
16339   @@e_signature:\r
16340   end;\r
16341   if howToDestroy = ddOnAppletDestroy then\r
16342     SL.Add( Prefix + 'Applet.Add2AutoFree( ' + inherited FormName + ' );' );\r
16343 end;\r
16344 \r
16345 procedure TKOLDataModule.SetupLast(SL: TStringList; const AName, AParent,\r
16346   Prefix: String);\r
16347 begin\r
16348   asm\r
16349     jmp @@e_signature\r
16350     DB '#$signature$#', 0\r
16351     DB 'TKOLDataModule.SetupLast', 0\r
16352   @@e_signature:\r
16353   end;\r
16354   // nothing\r
16355 end;\r
16356 \r
16357 { TKOLObjectCompEditor }\r
16358 \r
16359 //////////////////////////////////////////////////////////////////////////////////\r
16360 {$IFDEF _D6orHigher}                                                            //\r
16361 procedure TKOLObjectCompEditor.CheckEdit(const PropertyEditor: IProperty);      //\r
16362 {$ELSE}                                                                         //\r
16363 //////////////////////////////////////////////////////////////////////////////////\r
16364 procedure TKOLObjectCompEditor.CheckEdit(PropertyEditor: TPropertyEditor);\r
16365 var\r
16366   FreeEditor: Boolean;\r
16367 //////////////////////////////////////////////////////////////////////////////////\r
16368 {$ENDIF}                                                                        //\r
16369 //////////////////////////////////////////////////////////////////////////////////\r
16370 begin\r
16371   asm\r
16372     jmp @@e_signature\r
16373     DB '#$signature$#', 0\r
16374     DB 'TKOLObjectCompEditor.CheckEdit', 0\r
16375   @@e_signature:\r
16376   end;\r
16377 {$IFNDEF _D6orHigher}\r
16378   FreeEditor := True;\r
16379 {$ENDIF}\r
16380   try\r
16381 //*///////////////////////////////////////////////////////////////////////////////////////////////\r
16382 //    if FContinue then EditProperty(PropertyEditor, FContinue, FreeEditor);\r
16383 //*///////////////////////////////////////////////////////////////////////////////////////////////\r
16384     if FContinue then EditProperty(PropertyEditor, FContinue{$IFNDEF _D6orHigher}, FreeEditor{$ENDIF}); //\r
16385 //*///////////////////////////////////////////////////////////////////////////////////////////////\r
16386   finally\r
16387 //*///////////////////////////////////////////////\r
16388 {$IFNDEF _D6orHigher}                           //\r
16389 //*///////////////////////////////////////////////\r
16390     if FreeEditor then PropertyEditor.Free;\r
16391 //*///////////////////////////////////////////////\r
16392 {$ENDIF}                                        //\r
16393 //*///////////////////////////////////////////////\r
16394   end;\r
16395 end;\r
16396 \r
16397 //////////////////////////////////////////////////////////////////////////////////\r
16398 {$IFDEF _D6orHigher}                                                            //\r
16399 procedure TKOLObjectCompEditor.CountEvents(const PropertyEditor: IProperty );   //\r
16400 {$ELSE}                                                                         //\r
16401 //////////////////////////////////////////////////////////////////////////////////\r
16402 procedure TKOLObjectCompEditor.CountEvents( PropertyEditor: TPropertyEditor);\r
16403 //////////////////////////////////////////////////////////////////////////////////\r
16404 {$ENDIF}                                                                        //\r
16405 //////////////////////////////////////////////////////////////////////////////////\r
16406 begin\r
16407   asm\r
16408     jmp @@e_signature\r
16409     DB '#$signature$#', 0\r
16410     DB 'TKOLObjectCompEditor.CountEvents', 0\r
16411   @@e_signature:\r
16412   end;\r
16413   {$IFDEF _D6orHigher}\r
16414   if Supports( PropertyEditor, IMethodProperty ) then\r
16415   {$ELSE}\r
16416   if PropertyEditor is TMethodProperty then\r
16417   {$ENDIF}\r
16418     Inc( FCount );\r
16419   {$IFNDEF _D6orHigher}\r
16420   PropertyEditor.Free;\r
16421   {$ENDIF}              \r
16422 end;\r
16423 \r
16424 procedure TKOLObjectCompEditor.Edit;\r
16425 var\r
16426   {$IFDEF _D5orHigher}\r
16427   {$IFDEF _D6orHigher}\r
16428   Components: IDesignerSelections;\r
16429   {$ELSE}\r
16430   Components: TDesignerSelectionList;\r
16431   {$ENDIF}\r
16432   {$ELSE}\r
16433   Components: TComponentList;\r
16434   {$ENDIF}\r
16435 begin\r
16436   asm\r
16437     jmp @@e_signature\r
16438     DB '#$signature$#', 0\r
16439     DB 'TKOLObjectCompEditor.Edit', 0\r
16440   @@e_signature:\r
16441   end;\r
16442   {if Component.ClassNameIs( 'TKOLForm' ) then\r
16443   begin\r
16444     inherited;\r
16445     Exit;\r
16446   end;}\r
16447   {$IFDEF _D2orD3orD4}\r
16448   Components := TComponentList.Create;\r
16449   {$ELSE}\r
16450   {$IFDEF _D6orHigher}\r
16451   Components := CreateSelectionList;\r
16452   {$ELSE}\r
16453   Components := TDesignerSelectionList.Create;\r
16454   {$ENDIF}\r
16455   {$ENDIF}\r
16456 \r
16457   try\r
16458     BestEventName := '';\r
16459     if Component is TKOLObj then\r
16460       BestEventName := (Component as TKOLObj).BestEventName\r
16461     else\r
16462     if Component is TKOLApplet then\r
16463       BestEventName := (Component as TKOLApplet).BestEventName\r
16464     else\r
16465     if Component is TKOLCustomControl then\r
16466       BestEventName := (Component as TKOLCustomControl).BestEventName;\r
16467     FContinue := True;\r
16468 //////////////////////////////////////////////////////////\r
16469   {$IFDEF _D6orHigher}                                  //\r
16470     Components.Add(Component);\r
16471   {$ELSE}                                               //\r
16472 //////////////////////////////////////////////////////////\r
16473     Components.Add(Component);\r
16474 //////////////////////////////////////////////////////////\r
16475   {$ENDIF}                                              //\r
16476 //////////////////////////////////////////////////////////\r
16477     FFirst := nil;\r
16478     FBest := nil;\r
16479     try\r
16480       GetComponentProperties(Components, tkAny, Designer, CountEvents);\r
16481       //ShowMessage( 'Found ' + IntToStr( FCount ) + ' events' );\r
16482       GetComponentProperties(Components, tkAny, Designer, CheckEdit);\r
16483       if FContinue then\r
16484         if Assigned(FBest) then\r
16485         begin\r
16486           FBest.Edit;\r
16487           //ShowMessage( 'Best found ' + FBest.GetName );\r
16488         end\r
16489           else\r
16490         if Assigned(FFirst) then\r
16491         begin\r
16492           FFirst.Edit;\r
16493           //ShowMessage( 'First found ' + FFirst.GetName );\r
16494         end;\r
16495     finally\r
16496       {$IFDEF _D6orHigher}\r
16497       FFirst := nil;\r
16498       FBest := nil;\r
16499       {$ELSE}\r
16500       FFirst.Free;\r
16501       FBest.Free;\r
16502       {$ENDIF}\r
16503     end;\r
16504   finally\r
16505     {$IFDEF _D6orHigher}\r
16506     Components := nil;\r
16507     {$ELSE}\r
16508     Components.Free;\r
16509     {$ENDIF}\r
16510     //ShowMessage( 'FREE' );\r
16511   end;\r
16512 end;\r
16513 \r
16514 //////////////////////////////////////////////////////////////////////////////////////////////////////////\r
16515 {$IFDEF _D6orHigher}                                                                                   //\r
16516 procedure TKOLObjectCompEditor.EditProperty(const PropertyEditor: IProperty; var Continue: Boolean);    //\r
16517 {$ELSE}\r
16518 //////////////////////////////////////////////////////////////////////////////////////////////////////////\r
16519 procedure TKOLObjectCompEditor.EditProperty(\r
16520   PropertyEditor: TPropertyEditor; var Continue, FreeEditor: Boolean);\r
16521 //////////////////////////\r
16522 {$ENDIF}                //\r
16523 //////////////////////////\r
16524 var\r
16525   PropName: string;\r
16526   BestName: string;\r
16527 \r
16528   procedure ReplaceBest;\r
16529   begin\r
16530     {$IFDEF _D6orHigher}\r
16531     FBest := nil;\r
16532     {$ELSE}\r
16533     FBest.Free;\r
16534     {$ENDIF}\r
16535     FBest := PropertyEditor;\r
16536     if FFirst = FBest then FFirst := nil;\r
16537     {$IFNDEF _D6orHigher}\r
16538     FreeEditor := False;\r
16539     {$ENDIF}\r
16540   end;\r
16541 \r
16542 begin\r
16543   asm\r
16544     jmp @@e_signature\r
16545     DB '#$signature$#', 0\r
16546     DB 'TKOLObjectCompEditor.EditProperty', 0\r
16547   @@e_signature:\r
16548   end;\r
16549   {if Component.ClassNameIs( 'TKOLForm' ) then\r
16550   begin\r
16551     inherited;\r
16552     Exit;\r
16553   end;}\r
16554   {$IFDEF _D6orHigher}\r
16555   if not Assigned(FFirst) and Supports(PropertyEditor, IMethodProperty) then\r
16556   {$ELSE}\r
16557   if not Assigned(FFirst) and (PropertyEditor is TMethodProperty) then\r
16558   {$ENDIF}\r
16559   begin\r
16560     {$IFNDEF _D6orHigher}\r
16561     FreeEditor := False;\r
16562     {$ENDIF}\r
16563     FFirst := PropertyEditor;\r
16564   end;\r
16565   PropName := PropertyEditor.GetName;\r
16566   BestName := BestEventName;\r
16567   {$IFDEF _D6orHigher}\r
16568   if Supports( PropertyEditor, IMethodProperty ) then\r
16569   {$ELSE}\r
16570   if PropertyEditor is TMethodProperty then\r
16571   {$ENDIF}\r
16572   if (CompareText(PropName, BestName ) = 0) or (FCount = 1) then\r
16573     ReplaceBest\r
16574   else\r
16575     if (BestName = '') and\r
16576        (CompareText( PropName, 'ONDESTROY' ) <> 0) then\r
16577       ReplaceBest;\r
16578 end;\r
16579 \r
16580 { TKOLOnEventPropEditor }\r
16581 \r
16582 procedure TKOLOnEventPropEditor.Edit;\r
16583 var\r
16584   FormMethodName: string;\r
16585 begin\r
16586   asm\r
16587     jmp @@e_signature\r
16588     DB '#$signature$#', 0\r
16589     DB 'TKOLOnEventPropEditor.Edit', 0\r
16590   @@e_signature:\r
16591   end;\r
16592   FormMethodName := GetValue;\r
16593   if (FormMethodName = '') or\r
16594     Designer.MethodFromAncestor(GetMethodValue) then\r
16595   begin\r
16596     if FormMethodName = '' then\r
16597       FormMethodName := GetFormMethodName;\r
16598     if FormMethodName = '' then\r
16599       {$IFDEF _D3orD4}\r
16600       raise EPropertyError.Create(SCannotCreateName);\r
16601       {$ELSE}\r
16602       raise EPropertyError.CreateRes( {$IFNDEF _D2}@{$ENDIF} SCannotCreateName);\r
16603       {$ENDIF}\r
16604     SetValue(FormMethodName);\r
16605   end;\r
16606   Designer.ShowMethod(FormMethodName);\r
16607 end;\r
16608 \r
16609 {$IFDEF _D2}\r
16610 function TKOLOnEventPropEditor.GetFormMethodName: String;\r
16611 var\r
16612   I: Integer;\r
16613 begin\r
16614   asm\r
16615     jmp @@e_signature\r
16616     DB '#$signature$#', 0\r
16617     DB 'TKOLOnEventPropEditor.GetFormMethodName', 0\r
16618   @@e_signature:\r
16619   end;\r
16620   if GetComponent(0) = Designer.GetRoot then\r
16621   begin\r
16622     Result := Designer.GetRoot.ClassName;\r
16623     if (Result <> '') and (Result[1] = 'T') then\r
16624       Delete(Result, 1, 1);\r
16625   end\r
16626   else\r
16627   begin\r
16628     {$IFDEF _D2}\r
16629     Result := GetComponent(0).Name;\r
16630     {$ELSE _D3orHigher}\r
16631     Result := Designer.GetObjectName(GetComponent(0));\r
16632     {$ENDIF}\r
16633     for I := Length(Result) downto 1 do\r
16634       if Result[I] in ['.','[',']'] then\r
16635         Delete(Result, I, 1);\r
16636   end;\r
16637   if Result = '' then\r
16638     raise EPropertyError.CreateRes( SCannotCreateName );\r
16639   Result := Result + GetTrimmedEventName;\r
16640 end;\r
16641 \r
16642 function TKOLOnEventPropEditor.GetTrimmedEventName: String;\r
16643 begin\r
16644   asm\r
16645     jmp @@e_signature\r
16646     DB '#$signature$#', 0\r
16647     DB 'TKOLOnEventPropEditor.GetTrimmedEventName', 0\r
16648   @@e_signature:\r
16649   end;\r
16650   Result := GetName;\r
16651   if (Length(Result) >= 2) and\r
16652     (Result[1] in ['O','o']) and (Result[2] in ['N','n']) then\r
16653     Delete(Result,1,2);\r
16654 end;\r
16655 {$ENDIF _D2}\r
16656 \r
16657 {function SearchKOLProject( KOLPrj: Pointer; Child: TIComponentInterface ): Boolean;\r
16658          stdcall;\r
16659 type PIComponentInterface = ^TIComponentInterface;\r
16660 begin\r
16661   if CompareText( Child.GetComponentType, 'TKOLProject' ) = 0 then\r
16662   begin\r
16663     PIComponentInterface( KOLPrj )^ := Child;\r
16664     Result := FALSE;\r
16665   end\r
16666     else\r
16667   begin\r
16668     Child.Free;\r
16669     Result := TRUE;\r
16670   end;\r
16671 end;}\r
16672 \r
16673 function BuildKOLProject: Boolean;\r
16674 {var N, I: Integer;\r
16675     S: String;}\r
16676     //ModIntf: TIModuleInterface;\r
16677     //FrmIntf: TIFormInterface;\r
16678     //CompIntf: TIComponentInterface;\r
16679     //PrjIntf: TIComponentInterface;\r
16680     //Value: LongBool;\r
16681 begin\r
16682   asm\r
16683     jmp @@e_signature\r
16684     DB '#$signature$#', 0\r
16685     DB 'BuildKOLProject', 0\r
16686   @@e_signature:\r
16687   end;\r
16688   Result := FALSE;\r
16689   if KOLProject <> nil then\r
16690     Result := KOLProject.ConvertVCL2KOL( FALSE );\r
16691   if not Result then\r
16692   begin\r
16693     ShowMessage( 'Main form is not opened, and changing of the project dpr file ' +\r
16694                  'is not finished. To apply changes, open and show main form.' );\r
16695   end;\r
16696 end;\r
16697 \r
16698 { TCursorPropEditor }\r
16699 \r
16700 function TCursorPropEditor.GetAttributes: TPropertyAttributes;\r
16701 begin\r
16702   asm\r
16703     jmp @@e_signature\r
16704     DB '#$signature$#', 0\r
16705     DB 'TCursorPropEditor.GetAttributes', 0\r
16706   @@e_signature:\r
16707   end;\r
16708   Result := [ paValueList, paSortList ];\r
16709 end;\r
16710 \r
16711 function TCursorPropEditor.GetValue: string;\r
16712 begin\r
16713   asm\r
16714     jmp @@e_signature\r
16715     DB '#$signature$#', 0\r
16716     DB 'TCursorPropEditor.GetValue', 0\r
16717   @@e_signature:\r
16718   end;\r
16719   Result := GetStrValue;\r
16720 end;\r
16721 \r
16722 procedure TCursorPropEditor.GetValues(Proc: TGetStrProc);\r
16723 const\r
16724   Cursors: array[ 0..16 ] of String = ( ' ', 'IDC_ARROW', 'IDC_IBEAM', 'IDC_WAIT',\r
16725   'IDC_CROSS', 'IDC_UPARROW', 'IDC_SIZE', 'IDC_ICON', 'IDC_SIZENWSE', 'IDC_SIZENESW',\r
16726   'IDC_SIZEWE', 'IDC_SIZENS', 'IDC_SIZEALL', 'IDC_NO', 'IDC_HAND', 'IDC_APPSTARTING',\r
16727   'IDC_HELP' );\r
16728 var I: Integer;\r
16729     Found: Boolean;\r
16730 begin\r
16731   asm\r
16732     jmp @@e_signature\r
16733     DB '#$signature$#', 0\r
16734     DB 'TCursorPropEditor.GetValues', 0\r
16735   @@e_signature:\r
16736   end;\r
16737   Found := FALSE;\r
16738   for I := 0 to High( Cursors ) do\r
16739     if Trim( Value ) = Trim( Cursors[ I ] ) then\r
16740     begin\r
16741       Found := TRUE;\r
16742       break;\r
16743     end;\r
16744   if not Found then\r
16745     Proc( Value );\r
16746   for I := 0 to High( Cursors ) do\r
16747     Proc( Cursors[ I ] );\r
16748 end;\r
16749 \r
16750 procedure TCursorPropEditor.SetValue(const Value: string);\r
16751 begin\r
16752   asm\r
16753     jmp @@e_signature\r
16754     DB '#$signature$#', 0\r
16755     DB 'TCursorPropEditor.SetValue', 0\r
16756   @@e_signature:\r
16757   end;\r
16758   SetStrValue( Trim( Value ) );\r
16759 end;\r
16760 \r
16761 { TKOLFrame }\r
16762 \r
16763 function TKOLFrame.AutoCaption: Boolean;\r
16764 begin\r
16765   asm\r
16766     jmp @@e_signature\r
16767     DB '#$signature$#', 0\r
16768     DB 'TKOLFrame.AutoCaption', 0\r
16769   @@e_signature:\r
16770   end;\r
16771   Result := FALSE;\r
16772 end;\r
16773 \r
16774 constructor TKOLFrame.Create(AOwner: TComponent);\r
16775 begin\r
16776   asm\r
16777     jmp @@e_signature\r
16778     DB '#$signature$#', 0\r
16779     DB 'TKOLFrame.Create', 0\r
16780   @@e_signature:\r
16781   end;\r
16782   inherited;\r
16783   edgeStyle := esNone;\r
16784   FParentFont := TRUE;\r
16785   FParentColor := TRUE;\r
16786 end;\r
16787 \r
16788 procedure TKOLFrame.GenerateAdd2AutoFree(SL: TStringList;\r
16789   const AName: String; AControl: Boolean; Add2AutoFreeProc: String; Obj: TObject);\r
16790 begin\r
16791   asm\r
16792     jmp @@e_signature\r
16793     DB '#$signature$#', 0\r
16794     DB 'TKOLFrame.GenerateAdd2AutoFree', 0\r
16795   @@e_signature:\r
16796   end;\r
16797   if Obj <> nil then\r
16798   if Obj is TKOLObj then\r
16799   if (Obj as TKOLObj).NotAutoFree then\r
16800     Exit;\r
16801   if Add2AutoFreeProc = '' then\r
16802     Add2AutoFreeProc := 'Add2AutoFree';\r
16803   if not AControl then\r
16804     SL.Add( '  Result.Form.' + Add2AutoFreeProc + '( ' + AName + ' );' );\r
16805 end;\r
16806 \r
16807 procedure TKOLFrame.GenerateCreateForm(SL: TStringList);\r
16808 const EdgeStyles: array[ TEdgeStyle ] of String = (\r
16809       'esRaised', 'esLowered', 'esNone' );\r
16810 var S: String;\r
16811 begin\r
16812   asm\r
16813     jmp @@e_signature\r
16814     DB '#$signature$#', 0\r
16815     DB 'TKOLFrame.GenerateCreateForm', 0\r
16816   @@e_signature:\r
16817   end;\r
16818   S := GenerateTransparentInits;\r
16819 \r
16820   SL.Add( '  Result.Form := NewPanel( AParent, ' + EdgeStyles[ edgeStyle ] + ' )' +\r
16821           S + ';' );\r
16822   if Caption <> '' then\r
16823     SL.Add( '  Result.Form.Caption := ' + StringConstant( 'Caption', Caption ) + ';' );\r
16824 end;\r
16825 \r
16826 function TKOLFrame.GenerateTransparentInits: String;\r
16827 var W, H: Integer;\r
16828 begin\r
16829   asm\r
16830     jmp @@e_signature\r
16831     DB '#$signature$#', 0\r
16832     DB 'TKOLFrame.GenerateTransparentInits', 0\r
16833   @@e_signature:\r
16834   end;\r
16835   Result := '';\r
16836   if FLocked then Exit;\r
16837 \r
16838   if Align <> caNone then\r
16839     Result := '.SetAlign( ' + AlignValues[ Align ] + ')';\r
16840 \r
16841   if Align <> caNone then\r
16842   begin\r
16843     W := Width;\r
16844     H := Height;\r
16845     if Align in [ caLeft, caRight ] then H := 0;\r
16846     if Align in [ caTop, caBottom ] then W := 0;\r
16847     Result := Result + '.SetSize( ' + IntToStr( W ) + ', ' +\r
16848               IntToStr( H ) + ' )';\r
16849   end;\r
16850 \r
16851   if CenterOnParent and (Align = caNone) then\r
16852     Result := Result + '.CenterOnParent';\r
16853 \r
16854   if zOrderTopmost then\r
16855     Result := Result + '.BringToFront';\r
16856 \r
16857   if HelpContext <> 0 then\r
16858     Result := Result + '.AssignHelpContext( ' + IntToStr( HelpContext ) + ' )';\r
16859 \r
16860 end;\r
16861 \r
16862 function TKOLFrame.GetCaption: String;\r
16863 begin\r
16864   asm\r
16865     jmp @@e_signature\r
16866     DB '#$signature$#', 0\r
16867     DB 'TKOLFrame.GetCaption', 0\r
16868   @@e_signature:\r
16869   end;\r
16870   Result := fFrameCaption;\r
16871   if Owner is TForm then\r
16872   if (Owner as TForm).Caption <> Result then\r
16873     (Owner as TForm).Caption := Result;\r
16874 end;\r
16875 \r
16876 function TKOLFrame.GetFrameHeight: Integer;\r
16877 begin\r
16878   asm\r
16879     jmp @@e_signature\r
16880     DB '#$signature$#', 0\r
16881     DB 'TKOLFrame.GetFrameHeight', 0\r
16882   @@e_signature:\r
16883   end;\r
16884   Result := inherited Bounds.Height;\r
16885 end;\r
16886 \r
16887 function TKOLFrame.GetFrameWidth: Integer;\r
16888 begin\r
16889   asm\r
16890     jmp @@e_signature\r
16891     DB '#$signature$#', 0\r
16892     DB 'TKOLFrame.GetFrameHeight', 0\r
16893   @@e_signature:\r
16894   end;\r
16895   Result := inherited Bounds.Width;\r
16896 end;\r
16897 \r
16898 procedure TKOLFrame.SetAlign(const Value: TKOLAlign);\r
16899 begin\r
16900   asm\r
16901     jmp @@e_signature\r
16902     DB '#$signature$#', 0\r
16903     DB 'TKOLFrame.SetAlign', 0\r
16904   @@e_signature:\r
16905   end;\r
16906   FAlign := Value;\r
16907   Change( Self );\r
16908 end;\r
16909 \r
16910 procedure TKOLFrame.SetCenterOnParent(const Value: Boolean);\r
16911 begin\r
16912   asm\r
16913     jmp @@e_signature\r
16914     DB '#$signature$#', 0\r
16915     DB 'TKOLFrame.SetCenterOnParent', 0\r
16916   @@e_signature:\r
16917   end;\r
16918   FCenterOnParent := Value;\r
16919   Change( Self );\r
16920 end;\r
16921 \r
16922 procedure TKOLFrame.SetEdgeStyle(const Value: TEdgeStyle);\r
16923 begin\r
16924   asm\r
16925     jmp @@e_signature\r
16926     DB '#$signature$#', 0\r
16927     DB 'TKOLFrame.SetEdgeStyle', 0\r
16928   @@e_signature:\r
16929   end;\r
16930   FEdgeStyle := Value;\r
16931   Change( Self );\r
16932 end;\r
16933 \r
16934 procedure TKOLFrame.SetFrameCaption(const Value: String);\r
16935 begin\r
16936   asm\r
16937     jmp @@e_signature\r
16938     DB '#$signature$#', 0\r
16939     DB 'TKOLFrame.SetFrameCaption', 0\r
16940   @@e_signature:\r
16941   end;\r
16942   fFrameCaption := Value;\r
16943   Change( Self );\r
16944 end;\r
16945 \r
16946 procedure TKOLFrame.SetFrameHeight(const Value: Integer);\r
16947 begin\r
16948   asm\r
16949     jmp @@e_signature\r
16950     DB '#$signature$#', 0\r
16951     DB 'TKOLFrame.SetFrameHeight', 0\r
16952   @@e_signature:\r
16953   end;\r
16954   inherited Bounds.Height := Value;\r
16955 end;\r
16956 \r
16957 procedure TKOLFrame.SetFrameWidth(const Value: Integer);\r
16958 begin\r
16959   asm\r
16960     jmp @@e_signature\r
16961     DB '#$signature$#', 0\r
16962     DB 'TKOLFrame.SetFrameWidth', 0\r
16963   @@e_signature:\r
16964   end;\r
16965   inherited Bounds.Width := Value;\r
16966 end;\r
16967 \r
16968 procedure TKOLFrame.SetParentColor(const Value: Boolean);\r
16969 begin\r
16970   FParentColor := Value;\r
16971   Change( Self );\r
16972 end;\r
16973 \r
16974 procedure TKOLFrame.SetParentFont(const Value: Boolean);\r
16975 begin\r
16976   FParentFont := Value;\r
16977   Change( Self );\r
16978 end;\r
16979 \r
16980 procedure TKOLFrame.SetupFirst(SL: TStringList; const AName, AParent,\r
16981   Prefix: String);\r
16982 begin\r
16983   inherited;\r
16984   if not ParentFont then\r
16985     Font.GenerateCode( SL, AName, nil );\r
16986   if not ParentColor then\r
16987     SL.Add( Prefix + AName + '.Color := ' + ColorToString( Color ) + ';' );\r
16988 end;\r
16989 \r
16990 procedure TKOLFrame.SetupLast(SL: TStringList; const AName, AParent,\r
16991   Prefix: String);\r
16992 begin\r
16993   asm\r
16994     jmp @@e_signature\r
16995     DB '#$signature$#', 0\r
16996     DB 'TKOLFrame.SetupLast', 0\r
16997   @@e_signature:\r
16998   end;\r
16999   inherited;\r
17000   SL.Add( '    Result.Form.CreateWindow;' );\r
17001 end;\r
17002 \r
17003 procedure TKOLFrame.SetzOrderTopmost(const Value: Boolean);\r
17004 begin\r
17005   asm\r
17006     jmp @@e_signature\r
17007     DB '#$signature$#', 0\r
17008     DB 'TKOLFrame.SetzOrderTopmost', 0\r
17009   @@e_signature:\r
17010   end;\r
17011   FzOrderTopmost := Value;\r
17012   Change( Self );\r
17013 end;\r
17014 \r
17015 { TKOLMDIChild }\r
17016 \r
17017 function TKOLMDIChild.DoNotGenerateSetPosition: Boolean;\r
17018 begin\r
17019   asm\r
17020     jmp @@e_signature\r
17021     DB '#$signature$#', 0\r
17022     DB 'TKOLMDIChild.DoNotGenerateSetPosition', 0\r
17023   @@e_signature:\r
17024   end;\r
17025   Result := TRUE;\r
17026 end;\r
17027 \r
17028 procedure TKOLMDIChild.GenerateCreateForm(SL: TStringList);\r
17029 var S: String;\r
17030 begin\r
17031   asm\r
17032     jmp @@e_signature\r
17033     DB '#$signature$#', 0\r
17034     DB 'TKOLMDIChild.GenerateCreateForm', 0\r
17035   @@e_signature:\r
17036   end;\r
17037   S := GenerateTransparentInits;\r
17038   SL.Add( '  Result.Form := NewMDIChild( AParent, ' + StringConstant( 'Caption', Caption ) +\r
17039           ' )' + S + ';' );\r
17040 end;\r
17041 \r
17042 procedure TKOLMDIChild.SetParentForm(const Value: String);\r
17043 begin\r
17044   asm\r
17045     jmp @@e_signature\r
17046     DB '#$signature$#', 0\r
17047     DB 'TKOLMDIChild.SetParentForm', 0\r
17048   @@e_signature:\r
17049   end;\r
17050   if FParentForm = Value then Exit;\r
17051   FParentForm := Value;\r
17052   Change( Self );\r
17053 end;\r
17054 \r
17055 { TParentMDIFormPropEditor }\r
17056 \r
17057 function TParentMDIFormPropEditor.GetAttributes: TPropertyAttributes;\r
17058 begin\r
17059   asm\r
17060     jmp @@e_signature\r
17061     DB '#$signature$#', 0\r
17062     DB 'TKOLMDIFormPropEditor.GetAttributes', 0\r
17063   @@e_signature:\r
17064   end;\r
17065   Result := [ paValueList, paSortList ];\r
17066 end;\r
17067 \r
17068 function TParentMDIFormPropEditor.GetValue: string;\r
17069 begin\r
17070   asm\r
17071     jmp @@e_signature\r
17072     DB '#$signature$#', 0\r
17073     DB 'TKOLMDIFormPropEditor.GetValue', 0\r
17074   @@e_signature:\r
17075   end;\r
17076   Result := GetStrValue;\r
17077 end;\r
17078 \r
17079 procedure TParentMDIFormPropEditor.GetValues(Proc: TGetStrProc);\r
17080 var I, J: Integer;\r
17081     UN, FormName: String;\r
17082     MI: TIModuleInterface;\r
17083     FI: TIFormInterface;\r
17084     CI, ChI: TIComponentInterface;\r
17085     IsMDIForm: Boolean;\r
17086 begin\r
17087   asm\r
17088     jmp @@e_signature\r
17089     DB '#$signature$#', 0\r
17090     DB 'TKOLMDIFormPropEditor.GetValues', 0\r
17091   @@e_signature:\r
17092   end;\r
17093   for I := 0 to ToolServices.GetUnitCount-1 do\r
17094   begin\r
17095       UN := ToolServices.GetUnitName( I );\r
17096       MI := ToolServices.GetModuleInterface( UN );\r
17097       if MI <> nil then\r
17098       TRY\r
17099         FI := MI.GetFormInterface;\r
17100         if FI <> nil then\r
17101         TRY\r
17102           CI := FI.GetFormComponent;\r
17103           if CI <> nil then\r
17104           TRY\r
17105             IsMDIForm := FALSE;\r
17106             FormName := '';\r
17107             for J := 0 to CI.GetComponentCount-1 do\r
17108             begin\r
17109               ChI := CI.GetComponent( J );\r
17110               if ChI.GetComponentType = 'TKOLForm' then\r
17111                 CI.GetPropValueByName( 'Name', FormName )\r
17112               else\r
17113               if ChI.GetComponentType = 'TKOLMDIClient' then\r
17114                 IsMDIForm := TRUE;\r
17115               if IsMDIForm and (FormName <> '') then\r
17116                 break;\r
17117             end;\r
17118             if IsMDIForm and (FormName <> '') then\r
17119               Proc( FormName );\r
17120           FINALLY\r
17121             CI.Free;\r
17122           END;\r
17123         FINALLY\r
17124           FI.Free;\r
17125         END;\r
17126       FINALLY\r
17127         MI.Free;\r
17128       END;\r
17129   end;\r
17130 end;\r
17131 \r
17132 procedure TParentMDIFormPropEditor.SetValue(const Value: string);\r
17133 begin\r
17134   asm\r
17135     jmp @@e_signature\r
17136     DB '#$signature$#', 0\r
17137     DB 'TParentMDIFormPropEditor.SetValue', 0\r
17138   @@e_signature:\r
17139   end;\r
17140   SetStrValue( Trim( Value ) );\r
17141 end;\r
17142 \r
17143 { TKOLMenu }\r
17144 \r
17145 procedure TKOLMenu.AssignEvents(SL: TStringList; const AName: String);\r
17146 begin\r
17147   asm\r
17148     jmp @@e_signature\r
17149     DB '#$signature$#', 0\r
17150     DB 'TKOLMenu.AssignEvents', 0\r
17151   @@e_signature:\r
17152   end;\r
17153   inherited;\r
17154   DoAssignEvents( SL, AName, [ 'OnUncheckRadioItem', 'OnMeasureItem', 'OnDrawItem' ],\r
17155                              [ @ OnUncheckRadioItem, @ OnMeasureItem, @ OnDrawItem ] );\r
17156 end;\r
17157 \r
17158 procedure TKOLMenu.Change;\r
17159 begin\r
17160   asm\r
17161     jmp @@e_signature\r
17162     DB '#$signature$#', 0\r
17163     DB 'TKOLMenu.Change', 0\r
17164   @@e_signature:\r
17165   end;\r
17166   inherited;\r
17167   if ActiveDesign <> nil then\r
17168      ActiveDesign.RefreshItems;\r
17169   //if not FReading then\r
17170   //begin\r
17171     if ParentForm <> nil then\r
17172 ////////////////////////////////////////////\r
17173       if ParentForm.Designer <> nil then  //    èíîãäà ìîæåò áûòü NIL ...\r
17174 ////////////////////////////////////////////\r
17175       ParentForm.Designer.Modified;\r
17176   //end;\r
17177 end;\r
17178 \r
17179 constructor TKOLMenu.Create(AOwner: TComponent);\r
17180 begin\r
17181   asm\r
17182     jmp @@e_signature\r
17183     DB '#$signature$#', 0\r
17184     DB 'TKOLMenu.Create', 0\r
17185   @@e_signature:\r
17186   end;\r
17187   inherited;\r
17188   FgenerateConstants := TRUE;\r
17189   FItems := TList.Create;\r
17190   NeedFree := False;\r
17191   Fshowshortcuts := True;\r
17192   fCreationPriority := 5;\r
17193 end;\r
17194 \r
17195 procedure TKOLMenu.DefineProperties(Filer: TFiler);\r
17196 var I: Integer;\r
17197     MI: TKOLMenuItem;\r
17198 begin\r
17199   asm\r
17200     jmp @@e_signature\r
17201     DB '#$signature$#', 0\r
17202     DB 'TKOLMenu.DefineProperties', 0\r
17203   @@e_signature:\r
17204   end;\r
17205   inherited;\r
17206   //--Filer.DefineProperty( 'Items', LoadItems, SaveItems, Count > 0 );\r
17207   Filer.DefineProperty( 'ItemCount', LoadItemCount, SaveItemCount, True );\r
17208   UpdateDisable;\r
17209   for I := 0 to FItemCount - 1 do\r
17210   begin\r
17211     if FItems.Count <= I then\r
17212       MI := TKOLMenuItem.Create( Self, nil, nil )\r
17213     else\r
17214       MI := FItems[ I ];\r
17215     MI.DefProps( 'Item' + Int2Str( I ), Filer );\r
17216   end;\r
17217   if not (csDestroying in ComponentState) then\r
17218     UpdateEnable;\r
17219 end;\r
17220 \r
17221 destructor TKOLMenu.Destroy;\r
17222 var I: Integer;\r
17223 begin\r
17224   asm\r
17225     jmp @@e_signature\r
17226     DB '#$signature$#', 0\r
17227     DB 'TKOLMenu.Destroy', 0\r
17228   @@e_signature:\r
17229   end;\r
17230   //ShowMessage( 'enter: KOLMenu.Destroy' );\r
17231   ActiveDesign.Free;\r
17232   //ShowMessage( 'AD freed' );\r
17233   for I := FItems.Count - 1 downto 0 do\r
17234   begin\r
17235     TObject( FItems[ I ] ).Free;\r
17236   end;\r
17237   //ShowMessage( 'Items freed' );\r
17238   FItems.Free;\r
17239   //ShowMessage( 'FItems freed' );\r
17240   inherited;\r
17241   //ShowMessage( 'leave: KOLMenu.Destroy' );\r
17242 end;\r
17243 \r
17244 procedure TKOLMenu.DoGenerateConstants(SL: TStringList);\r
17245 var N: Integer;\r
17246 \r
17247   procedure GenItemConst( MI: TKOLMenuItem );\r
17248   var J: Integer;\r
17249   begin\r
17250     if MI.Name <> '' then\r
17251     if MI.itemindex >= 0 then\r
17252     begin\r
17253       if not MI.separator or genearteSepeartorConstants then\r
17254         SL.Add( 'const ' + MI.Name + ' = ' + IntToStr( MI.itemindex ) + ';' );\r
17255       Inc( N );\r
17256     end;\r
17257     for J := 0 to MI.Count-1 do\r
17258       GenItemConst( MI.SubItems[ J ] );\r
17259   end;\r
17260 \r
17261 var I: Integer;\r
17262 begin\r
17263   if not generateConstants then Exit;\r
17264   N := 0;\r
17265   for I := 0 to Count-1 do\r
17266     GenItemConst( Items[ I ] );\r
17267   if N > 0 then\r
17268     SL.Add( '' );\r
17269 end;\r
17270 \r
17271 function TKOLMenu.GetCount: Integer;\r
17272 begin\r
17273   asm\r
17274     jmp @@e_signature\r
17275     DB '#$signature$#', 0\r
17276     DB 'TKOLMenu.GetCount', 0\r
17277   @@e_signature:\r
17278   end;\r
17279   Result := FItems.Count;\r
17280 end;\r
17281 \r
17282 function TKOLMenu.GetItems(Idx: Integer): TKOLMenuItem;\r
17283 begin\r
17284   asm\r
17285     jmp @@e_signature\r
17286     DB '#$signature$#', 0\r
17287     DB 'TKOLMenu.GetItems', 0\r
17288   @@e_signature:\r
17289   end;\r
17290   Result := nil;\r
17291   if (FItems <> nil) and (Idx >= 0) and (Idx < FItems.Count) then\r
17292     Result := FItems[ Idx ];\r
17293 end;\r
17294 \r
17295 procedure TKOLMenu.LoadItemCount(R: TReader);\r
17296 begin\r
17297   asm\r
17298     jmp @@e_signature\r
17299     DB '#$signature$#', 0\r
17300     DB 'TKOLMenu.LoadItemCount', 0\r
17301   @@e_signature:\r
17302   end;\r
17303   FItemCount := R.ReadInteger;\r
17304 end;\r
17305 \r
17306 function TKOLMenu.NameAlreadyUsed(const ItemName: String): Boolean;\r
17307   function NameUsed1( MI: TKOLMenuItem ): Boolean;\r
17308   var I: Integer;\r
17309       SI: TKOLMenuItem;\r
17310   begin\r
17311     Result := MI.Name = ItemName;\r
17312     if Result then Exit;\r
17313     for I := 0 to MI.Count - 1 do\r
17314     begin\r
17315       SI := MI.FSubItems[ I ];\r
17316       Result := NameUsed1( SI );\r
17317       if Result then Exit;\r
17318     end;\r
17319   end;\r
17320 var I, J: Integer;\r
17321     MI: TKOLMenuItem;\r
17322     F: TForm;\r
17323     C: TComponent;\r
17324     MC: TKOLMenu;\r
17325 begin\r
17326   asm\r
17327     jmp @@e_signature\r
17328     DB '#$signature$#', 0\r
17329     DB 'TKOLMenu.NameAlreadyUsed', 0\r
17330   @@e_signature:\r
17331   end;\r
17332   F := ParentForm;\r
17333   if F = nil then\r
17334   begin\r
17335     for I := 0 to FItems.Count - 1 do\r
17336     begin\r
17337       MI := FItems[ I ];\r
17338       Result := NameUsed1( MI );\r
17339       if Result then Exit;\r
17340     end;\r
17341     Result := False;\r
17342     Exit;\r
17343   end;\r
17344   Result := F.FindComponent( ItemName ) <> nil;\r
17345   if Result then Exit;\r
17346   for I := 0 to F.ComponentCount - 1 do\r
17347   begin\r
17348     C := F.Components[ I ];\r
17349     if C is TKOLMenu then\r
17350     begin\r
17351       MC := C as TKOLMenu;\r
17352       for J := 0 to MC.Count - 1 do\r
17353       begin\r
17354         MI := MC.FItems[ J ];\r
17355         Result := NameUsed1( MI );\r
17356         if Result then Exit;\r
17357       end;\r
17358     end;\r
17359   end;\r
17360   Result := False;\r
17361 end;\r
17362 \r
17363 function TKOLMenu.NotAutoFree: Boolean;\r
17364 begin\r
17365   asm\r
17366     jmp @@e_signature\r
17367     DB '#$signature$#', 0\r
17368     DB 'TKOLMenu.NotAutoFree', 0\r
17369   @@e_signature:\r
17370   end;\r
17371   Result := TRUE;\r
17372 end;\r
17373 \r
17374 function TKOLMenu.OnMenuItemMethodName: String;\r
17375 var F: TForm;\r
17376 begin\r
17377   asm\r
17378     jmp @@e_signature\r
17379     DB '#$signature$#', 0\r
17380     DB 'TKOLMenu.OnMenuItemMethodName', 0\r
17381   @@e_signature:\r
17382   end;\r
17383   Result := '';\r
17384   if TMethod( OnMenuItem ).Code <> nil then\r
17385   begin\r
17386     F := ParentForm;\r
17387     if F <> nil then\r
17388       Result := F.MethodName( TMethod( OnMenuItem ).Code );\r
17389   end;\r
17390   if Result = '' then\r
17391     Result := 'nil'\r
17392   else\r
17393     Result := 'Result.' + Result;\r
17394 end;\r
17395 \r
17396 procedure TKOLMenu.SaveItemCount(W: TWriter);\r
17397 begin\r
17398   asm\r
17399     jmp @@e_signature\r
17400     DB '#$signature$#', 0\r
17401     DB 'TKOLMenu.SaveItemCount', 0\r
17402   @@e_signature:\r
17403   end;\r
17404   FItemCount := FItems.Count;\r
17405   W.WriteInteger( FItemCount );\r
17406 end;\r
17407 \r
17408 procedure TKOLMenu.SaveTo(WR: TWriter);\r
17409 begin\r
17410   asm\r
17411     jmp @@e_signature\r
17412     DB '#$signature$#', 0\r
17413     DB 'TKOLMenu.SaveTo', 0\r
17414   @@e_signature:\r
17415   end;\r
17416   Writestate( WR );\r
17417 end;\r
17418 \r
17419 procedure TKOLMenu.SetgenearteSepeartorConstants(const Value: Boolean);\r
17420 begin\r
17421   FgenearteSepeartorConstants := Value;\r
17422   Change;\r
17423 end;\r
17424 \r
17425 procedure TKOLMenu.SetgenerateConstants(const Value: Boolean);\r
17426 begin\r
17427   FgenerateConstants := Value;\r
17428   Change;\r
17429 end;\r
17430 \r
17431 procedure TKOLMenu.SetName(const NewName: TComponentName);\r
17432 var S: String;\r
17433 begin\r
17434   asm\r
17435     jmp @@e_signature\r
17436     DB '#$signature$#', 0\r
17437     DB 'TKOLMenu.SetName', 0\r
17438   @@e_signature:\r
17439   end;\r
17440   inherited;\r
17441   if ActiveDesign <> nil then\r
17442   begin\r
17443     S := NewName;\r
17444     if ParentForm <> nil then\r
17445       S := ParentForm.Name + '.' + S;\r
17446     ActiveDesign.Caption := S;\r
17447   end;\r
17448 end;\r
17449 \r
17450 procedure TKOLMenu.SetOnDrawItem(const Value: TOnDrawItem);\r
17451 begin\r
17452   FOnDrawItem := Value;\r
17453   Change;\r
17454 end;\r
17455 \r
17456 procedure TKOLMenu.SetOnMeasureItem(const Value: TOnMeasureItem);\r
17457 begin\r
17458   FOnMeasureItem := Value;\r
17459   Change;\r
17460 end;\r
17461 \r
17462 procedure TKOLMenu.SetOnMenuItem(const Value: TOnMenuItem);\r
17463 begin\r
17464   asm\r
17465     jmp @@e_signature\r
17466     DB '#$signature$#', 0\r
17467     DB 'TKOLMenu.SetOnMenuItem', 0\r
17468   @@e_signature:\r
17469   end;\r
17470   FOnMenuItem := Value;\r
17471   Change;\r
17472 end;\r
17473 \r
17474 procedure TKOLMenu.SetOnUncheckRadioItem(const Value: TOnMenuItem);\r
17475 begin\r
17476   asm\r
17477     jmp @@e_signature\r
17478     DB '#$signature$#', 0\r
17479     DB 'TKOLMenu.SetOnUncheckRadioItem', 0\r
17480   @@e_signature:\r
17481   end;\r
17482   FOnUncheckRadioItem := Value;\r
17483   Change;\r
17484 end;\r
17485 \r
17486 procedure TKOLMenu.Setshowshortcuts(const Value: Boolean);\r
17487 begin\r
17488   asm\r
17489     jmp @@e_signature\r
17490     DB '#$signature$#', 0\r
17491     DB 'TKOLMenu.Setshowshortcuts', 0\r
17492   @@e_signature:\r
17493   end;\r
17494   Fshowshortcuts := Value;\r
17495   Change;\r
17496 end;\r
17497 \r
17498 procedure TKOLMenu.SetupFirst(SL: TStringList; const AName,\r
17499   AParent, Prefix: String);\r
17500 var I: Integer;\r
17501     S: String;\r
17502     MI: TKOLMenuItem;\r
17503 begin\r
17504   asm\r
17505     jmp @@e_signature\r
17506     DB '#$signature$#', 0\r
17507     DB 'TKOLMenu.SetupFirst', 0\r
17508   @@e_signature:\r
17509   end;\r
17510   if Count = 0 then Exit;\r
17511   SL.Add( Prefix + AName + ' := NewMenu( ' + AParent + ', 0, [ ' );\r
17512   for I := 0 to FItems.Count - 1 do\r
17513   begin\r
17514     MI := FItems[ I ];\r
17515     MI.SetupTemplate( SL, I = 0 );\r
17516   end;\r
17517   S := ''''' ], ' + OnMenuItemMethodName + ' );';\r
17518   if FItems.Count <> 0 then\r
17519     S := ', ' + S;\r
17520   if Length( S ) + Length( SL[ SL.Count - 1 ] ) > 64 then\r
17521     SL.Add( Prefix + '  ' + S )\r
17522   else\r
17523     SL[ SL.Count - 1 ] := SL[ SL.Count - 1 ] + S;\r
17524   for I := 0 to FItems.Count - 1 do\r
17525   begin\r
17526     MI := FItems[ I ];\r
17527     MI.SetupAttributes( SL, AName );\r
17528   end;\r
17529   GenerateTag( SL, AName, Prefix );\r
17530 end;\r
17531 \r
17532 procedure TKOLMenu.UpdateDisable;\r
17533 begin\r
17534   asm\r
17535     jmp @@e_signature\r
17536     DB '#$signature$#', 0\r
17537     DB 'TKOLMenu.UpdateDisable', 0\r
17538   @@e_signature:\r
17539   end;\r
17540   FUpdateDisabled := TRUE;\r
17541 end;\r
17542 \r
17543 procedure TKOLMenu.UpdateEnable;\r
17544 begin\r
17545   asm\r
17546     jmp @@e_signature\r
17547     DB '#$signature$#', 0\r
17548     DB 'TKOLMenu.UpdateEnable', 0\r
17549   @@e_signature:\r
17550   end;\r
17551   if not FUpdateDisabled then Exit;\r
17552   FUpdateDisabled := FALSE;\r
17553   if FUpdateNeeded then\r
17554   begin\r
17555     FUpdateNeeded := FALSE;\r
17556     UpdateMenu;\r
17557   end;\r
17558 end;\r
17559 \r
17560 procedure TKOLMenu.UpdateMenu;\r
17561 begin\r
17562   asm\r
17563     jmp @@e_signature\r
17564     DB '#$signature$#', 0\r
17565     DB 'TKOLMenu.UpdateMenu', 0\r
17566   @@e_signature:\r
17567   end;\r
17568   //\r
17569 end;\r
17570 \r
17571 { TKOLMenuItem }\r
17572 \r
17573 procedure TKOLMenuItem.Change;\r
17574 var Menu: TKOLMenu;\r
17575 begin\r
17576   asm\r
17577     jmp @@e_signature\r
17578     DB '#$signature$#', 0\r
17579     DB 'TKOLMenuItem.Change', 0\r
17580   @@e_signature:\r
17581   end;\r
17582   if csLoading in ComponentState then Exit;\r
17583   Menu := MenuComponent;\r
17584   if Menu <> nil then\r
17585     Menu.Change;\r
17586 end;\r
17587 \r
17588 constructor TKOLMenuItem.Create(AOwner: TComponent; AParent, Before: TKOLMenuItem);\r
17589 var Items: TList;\r
17590     I: Integer;\r
17591     S: String;\r
17592 begin\r
17593   asm\r
17594     jmp @@e_signature\r
17595     DB '#$signature$#', 0\r
17596     DB 'TKOLMenuItem.Create', 0\r
17597   @@e_signature:\r
17598   end;\r
17599   S := '';\r
17600   if Before <> nil then\r
17601     S := Before.Name\r
17602   else\r
17603     S := 'nil';\r
17604   if AOwner <> nil then\r
17605     S := AOwner.Name + ', ' + S\r
17606   else\r
17607     S := 'nil, ' + S;\r
17608   Rpt( 'TKOLMenuItem.Create( ' + S + ' );' );\r
17609   inherited Create( AOwner );\r
17610   FParent := AParent;\r
17611   if FParent = nil then\r
17612     FParent := AOwner;\r
17613   FAccelerator := TKOLAccelerator.Create;\r
17614   FAccelerator.FOwner := Self;\r
17615   FBitmap := TBitmap.Create;\r
17616   FSubitems := TList.Create;\r
17617   FEnabled := True;\r
17618   FVisible := True;\r
17619   if AOwner = nil then Exit;\r
17620   if AParent = nil then\r
17621     Items := (AOwner as TKOLMenu).FItems\r
17622   else\r
17623     Items := AParent.FSubItems;\r
17624   if Before = nil then\r
17625     Items.Add( Self )\r
17626   else\r
17627   begin\r
17628     I := Items.IndexOf( Before );\r
17629     if I < 0 then\r
17630       Items.Add( Self )\r
17631     else\r
17632       Items.Insert( I, Self );\r
17633   end;\r
17634 end;\r
17635 \r
17636 destructor TKOLMenuItem.Destroy;\r
17637 var I: Integer;\r
17638     Sub: TKOLMenuItem;\r
17639     Items: TList;\r
17640     S: String;\r
17641 begin\r
17642   asm\r
17643     jmp @@e_signature\r
17644     DB '#$signature$#', 0\r
17645     DB 'TKOLMenuItem.Destroy', 0\r
17646   @@e_signature:\r
17647   end;\r
17648   Rpt( 'Destroying: ' + Name );\r
17649   FDestroying := True;\r
17650   for I := FSubitems.Count - 1 downto 0 do\r
17651   begin\r
17652     Sub := FSubitems[ I ];\r
17653     Sub.Free;\r
17654   end;\r
17655   FSubitems.Free;\r
17656   Rpt( 'destoying ' + Name + ': subitems freeed' );\r
17657   FBitmap.Free;\r
17658   if Parent <> nil then\r
17659   begin\r
17660     Items := nil;\r
17661     if Parent is TKOLMenu then\r
17662       Items := MenuComponent.FItems\r
17663     else\r
17664     if Parent is TKOLMenuItem then\r
17665       Items := (Parent as TKOLMenuItem).FSubItems;\r
17666     if Items <> nil then\r
17667     begin\r
17668       I := Items.IndexOf( Self );\r
17669       if I >= 0 then\r
17670         Items.Delete( I );\r
17671     end;\r
17672   end;\r
17673   S := Name;\r
17674   FAccelerator.Free;\r
17675   inherited;\r
17676   Rpt( 'Desroyed ' + S );\r
17677 end;\r
17678 \r
17679 function TKOLMenuItem.GetCount: Integer;\r
17680 begin\r
17681   asm\r
17682     jmp @@e_signature\r
17683     DB '#$signature$#', 0\r
17684     DB 'TKOLMenuItem.GetCount', 0\r
17685   @@e_signature:\r
17686   end;\r
17687   Result := FSubitems.Count;\r
17688 end;\r
17689 \r
17690 function TKOLMenuItem.GetMenuComponent: TKOLMenu;\r
17691 var C: TComponent;\r
17692 begin\r
17693   asm\r
17694     jmp @@e_signature\r
17695     DB '#$signature$#', 0\r
17696     DB 'TKOLMenuItem.GetMenuComponent', 0\r
17697   @@e_signature:\r
17698   end;\r
17699   C := Owner;\r
17700   if C is TKOLMenuItem then\r
17701     Result := (C as TKOLMenuItem).GetMenuComponent\r
17702   else\r
17703   if C is TKOLMenu then\r
17704     Result := C as TKOLMenu\r
17705   else\r
17706     Result := nil;\r
17707 end;\r
17708 \r
17709 function TKOLMenuItem.GetSubItems(Idx: Integer): TKOLMenuItem;\r
17710 begin\r
17711   asm\r
17712     jmp @@e_signature\r
17713     DB '#$signature$#', 0\r
17714     DB 'TKOLMenuItem.GetSubItems', 0\r
17715   @@e_signature:\r
17716   end;\r
17717   Result := FSubitems[ Idx ];\r
17718 end;\r
17719 \r
17720 function TKOLMenuItem.GetUplevel: TKOLMenuItem;\r
17721 var C: TComponent;\r
17722 begin\r
17723   asm\r
17724     jmp @@e_signature\r
17725     DB '#$signature$#', 0\r
17726     DB 'TKOLMenuItem.GetUplevel', 0\r
17727   @@e_signature:\r
17728   end;\r
17729   C := Parent;\r
17730   if C is TKOLMenuItem then\r
17731     Result := C as TKOLMenuItem\r
17732   else\r
17733     Result := nil;\r
17734 end;\r
17735 \r
17736 procedure StrList2Binary( SL: TStringList; Data: TStream );\r
17737 var I: Integer;\r
17738     S: String;\r
17739     J: Integer;\r
17740     C: Byte;\r
17741 begin\r
17742   asm\r
17743     jmp @@e_signature\r
17744     DB '#$signature$#', 0\r
17745     DB 'StrList2Binary', 0\r
17746   @@e_signature:\r
17747   end;\r
17748   for I := 0 to SL.Count - 1 do\r
17749   begin\r
17750     S := SL[ I ];\r
17751     J := 1;\r
17752     while J < Length( S ) do\r
17753     begin\r
17754       C := Hex2Int( Copy( S, J, 2 ) );\r
17755       Data.Write( C, 1 );\r
17756       Inc( J, 2 );\r
17757     end;\r
17758   end;\r
17759 end;\r
17760 \r
17761 procedure Binary2StrList( Data: TStream; SL: TStringList );\r
17762 var S: String;\r
17763     C: Byte;\r
17764     V: String;\r
17765 begin\r
17766   asm\r
17767     jmp @@e_signature\r
17768     DB '#$signature$#', 0\r
17769     DB 'Binary2StrList', 0\r
17770   @@e_signature:\r
17771   end;\r
17772   while Data.Position < Data.Size do\r
17773   begin\r
17774     S := '';\r
17775     while (Data.Position < Data.Size) and (Length( S ) < 56) do\r
17776     begin\r
17777       Data.Read( C, 1 );\r
17778       V := Copy( Int2Hex( C, 2 ), 1, 2 );\r
17779       while Length( V ) < 2 do\r
17780         V := '0' + V;\r
17781       S := S + V;\r
17782     end;\r
17783     SL.Add( S );\r
17784   end;\r
17785 end;\r
17786 \r
17787 procedure TKOLMenuItem.SetBitmap(Value: TBitmap);\r
17788 begin\r
17789   asm\r
17790     jmp @@e_signature\r
17791     DB '#$signature$#', 0\r
17792     DB 'TKOLMenuItem.SetBitmap', 0\r
17793   @@e_signature:\r
17794   end;\r
17795   if Value <> nil then\r
17796     if Value.Width * Value.Height = 0 then\r
17797       Value := nil;\r
17798   if Value <> nil then\r
17799   begin\r
17800     if Parent is TKOLMainMenu then\r
17801     begin\r
17802       ShowMessage( 'Menu item in the menu bar can not be checked, so it is ' +\r
17803                    'not possible to assign bitmap to upper level items in ' +\r
17804                    'the main menu.' );\r
17805       Value := nil;\r
17806     end;\r
17807   end;\r
17808   if Value = nil then\r
17809   begin\r
17810     FBitmap.Width := 0;\r
17811     FBitmap.Height := 0;\r
17812   end\r
17813     else\r
17814   begin\r
17815     FBitmap.Assign( Value );\r
17816     FSeparator := False;\r
17817   end;\r
17818   Change;\r
17819 end;\r
17820 \r
17821 procedure TKOLMenuItem.SetCaption(const Value: String);\r
17822 begin\r
17823   asm\r
17824     jmp @@e_signature\r
17825     DB '#$signature$#', 0\r
17826     DB 'TKOLMenuItem.SetCaption', 0\r
17827   @@e_signature:\r
17828   end;\r
17829   if (Value <> '') and (Value[ 1 ] in ['-','+']) then\r
17830   begin\r
17831     if not( (Length( Value ) > 1) and (Value[ 1 ] = '-') and (Value[ 2 ] in ['-','+']) ) then\r
17832     ShowMessage( 'Please do not start menu caption with ''-'' or ''+'' characters, ' +\r
17833                  'such prefixes are reserved for internal use only. Or, at least ' +\r
17834                  'insert once more leading ''-'' character. This is by design ' +\r
17835                  'reasons, sorry.' );\r
17836   end;\r
17837   if Faction = nil then\r
17838     FCaption := Value\r
17839   else\r
17840     FCaption:=Faction.Caption;\r
17841   if FCaption <> '' then\r
17842     FSeparator := False;\r
17843   Change;\r
17844 end;\r
17845 \r
17846 procedure TKOLMenuItem.SetChecked(const Value: Boolean);\r
17847 begin\r
17848   asm\r
17849     jmp @@e_signature\r
17850     DB '#$signature$#', 0\r
17851     DB 'TKOLMenuItem.SetChecked', 0\r
17852   @@e_signature:\r
17853   end;\r
17854   if Faction = nil then\r
17855     FChecked := Value\r
17856   else\r
17857     FChecked := Faction.Checked;\r
17858   if FChecked then\r
17859     FSeparator := False;\r
17860   Change;\r
17861 end;\r
17862 \r
17863 procedure TKOLMenuItem.SetEnabled(const Value: Boolean);\r
17864 begin\r
17865   asm\r
17866     jmp @@e_signature\r
17867     DB '#$signature$#', 0\r
17868     DB 'TKOLMenuItem.SetEnabled', 0\r
17869   @@e_signature:\r
17870   end;\r
17871   if Faction = nil then\r
17872     FEnabled := Value\r
17873   else\r
17874     FEnabled := Faction.Enabled;\r
17875   if FEnabled then\r
17876     FSeparator := False;\r
17877   Change;\r
17878 end;\r
17879 \r
17880 function QueryFormDesigner( D: IDesigner; var FD: IFormDesigner ): Boolean;\r
17881 begin\r
17882   asm\r
17883     jmp @@e_signature\r
17884     DB '#$signature$#', 0\r
17885     DB 'QueryFormDesigner', 0\r
17886   @@e_signature:\r
17887   end;\r
17888   {$IFDEF _D4orHigher}\r
17889     Result := D.QueryInterface( IFormDesigner, FD ) = 0;\r
17890   {$ELSE}\r
17891     Result := False;\r
17892     if D is TFormDesigner then\r
17893     begin\r
17894       FD := D as TFormDesigner;\r
17895       Result := True;\r
17896     end;\r
17897   {$ENDIF}\r
17898 end;\r
17899 \r
17900 procedure TKOLMenuItem.SetName(const NewName: TComponentName);\r
17901 var OldName, NewMethodName: String;\r
17902     L: Integer;\r
17903     F: TForm;\r
17904     D: IDesigner;\r
17905     FD: IFormDesigner;\r
17906 begin\r
17907   asm\r
17908     jmp @@e_signature\r
17909     DB '#$signature$#', 0\r
17910     DB 'TKOLMenuItem.SetName', 0\r
17911   @@e_signature:\r
17912   end;\r
17913   OldName := Name;\r
17914   Rpt( 'Renaming ' + OldName + ' to ' + NewName );\r
17915   if (MenuComponent <> nil) and (OldName <> '') and\r
17916      MenuComponent.NameAlreadyUsed( NewName ) then\r
17917   begin\r
17918     ShowMessage( 'Can not rename to ' + NewName + ' - such name is already used.' );\r
17919     Exit;\r
17920   end;\r
17921   if (OldName <> '') and (NewName = '') then\r
17922   begin\r
17923     ShowMessage( 'Can not rename to '''' - name must not be empty.' );\r
17924     Exit;\r
17925   end;\r
17926   inherited;\r
17927   if OldName = '' then Exit;\r
17928   if FOnMenuMethodName <> '' then\r
17929   if MenuComponent <> nil then\r
17930   begin\r
17931     L := Length( OldName ) + 4;\r
17932     if LowerCase( Copy( FOnMenuMethodName, Length( FOnMenuMethodName ) - L + 1, L ) )\r
17933      = LowerCase( OldName + 'Menu' ) then\r
17934     begin\r
17935       // rename event handler also here:\r
17936       F := MenuComponent.ParentForm;\r
17937       NewMethodName := MenuComponent.Name + NewName + 'Menu';\r
17938       if F <> nil then\r
17939       begin\r
17940 //*///////////////////////////////////////////////////////\r
17941   {$IFDEF _D6orhigher}                                  //\r
17942         F.Designer.QueryInterface(IFormDesigner,D);     //\r
17943   {$ELSE}                                               //\r
17944 //*///////////////////////////////////////////////////////\r
17945         D := F.Designer;\r
17946 //*///////////////////////////////////////////////////////\r
17947   {$ENDIF}                                              //\r
17948 //*///////////////////////////////////////////////////////\r
17949         if D <> nil then\r
17950         if QueryFormDesigner( D, FD ) then\r
17951         //if D.QueryInterface( IFormDesigner, FD ) = 0 then\r
17952         begin\r
17953           if not FD.MethodExists( NewMethodName ) then\r
17954           begin\r
17955             FD.RenameMethod( FOnMenuMethodName, NewMethodName );\r
17956             if FD.MethodExists( NewMethodName ) then\r
17957               FOnMenuMethodName := NewMethodName;\r
17958           end;\r
17959         end;\r
17960       end;\r
17961     end;\r
17962   end;\r
17963   Change;\r
17964 end;\r
17965 \r
17966 procedure TKOLMenuItem.SetOnMenu(const Value: TOnMenuItem);\r
17967 var F: TForm;\r
17968     S: String;\r
17969 begin\r
17970   asm\r
17971     jmp @@e_signature\r
17972     DB '#$signature$#', 0\r
17973     DB 'TKOLMenuItem.SetOnMenu', 0\r
17974   @@e_signature:\r
17975   end;\r
17976   FOnMenu := Value;\r
17977   if TMethod( Value ).Code <> nil then\r
17978   begin\r
17979     if MenuComponent <> nil then\r
17980     begin\r
17981       F := (MenuComponent as TKOLMenu).ParentForm;\r
17982       S := F.MethodName( TMethod( Value ).Code );\r
17983       //Rpt( 'Assigned method: ' + S + ' (' +\r
17984       //     IntToStr( Integer( TMethod( Value ).Code ) ) + ')' );\r
17985       FOnMenuMethodName := S;\r
17986       //FOnMenuMethodNum := Integer( TMethod( Value ).Code );\r
17987       //if TMethod( Value ).Data = F then\r
17988       //  Rpt( 'Assigned method is of form object!' );\r
17989     end;\r
17990   end\r
17991     else\r
17992     FOnMenuMethodName := '';\r
17993   Change;\r
17994 end;\r
17995 \r
17996 {procedure TKOLMenuItem.SetRadioItem(const Value: Boolean);\r
17997 begin\r
17998   asm\r
17999     jmp @@e_signature\r
18000     DB '#$signature$#', 0\r
18001     DB 'TKOLMenuItem.SetRadioItem', 0\r
18002   @@e_signature:\r
18003   end;\r
18004   FRadioItem := Value;\r
18005   if Value then\r
18006     FSeparator := False;\r
18007   Change;\r
18008 end;}\r
18009 \r
18010 procedure TKOLMenuItem.SetVisible(const Value: Boolean);\r
18011 begin\r
18012   asm\r
18013     jmp @@e_signature\r
18014     DB '#$signature$#', 0\r
18015     DB 'TKOLMenuItem.SetVisible', 0\r
18016   @@e_signature:\r
18017   end;\r
18018   if Faction = nil then\r
18019     FVisible := Value\r
18020   else\r
18021     FVisible := Faction.Visible;\r
18022   Change;\r
18023 end;\r
18024 \r
18025 procedure TKOLMenuItem.MoveUp;\r
18026 var ParentItems: TList;\r
18027     I: Integer;\r
18028     Tmp: Pointer;\r
18029 begin\r
18030   asm\r
18031     jmp @@e_signature\r
18032     DB '#$signature$#', 0\r
18033     DB 'TKOLMenuItem.MoveUp', 0\r
18034   @@e_signature:\r
18035   end;\r
18036   if Parent = MenuComponent then\r
18037     ParentItems := MenuComponent.FItems\r
18038   else\r
18039     ParentItems := (Parent as TKOLMenuItem).FSubitems;\r
18040   I := ParentItems.IndexOf( Self );\r
18041   if I > 0 then\r
18042   begin\r
18043     Tmp := ParentItems[ I - 1 ];\r
18044     ParentItems[ I - 1 ] := Self;\r
18045     ParentItems[ I ] := Tmp;\r
18046     Change;\r
18047   end;\r
18048 end;\r
18049 \r
18050 procedure TKOLMenuItem.MoveDown;\r
18051 var ParentItems: TList;\r
18052     I: Integer;\r
18053     Tmp: Pointer;\r
18054 begin\r
18055   asm\r
18056     jmp @@e_signature\r
18057     DB '#$signature$#', 0\r
18058     DB 'TKOLMenuItem.MoveDown', 0\r
18059   @@e_signature:\r
18060   end;\r
18061   if Parent = MenuComponent then\r
18062     ParentItems := MenuComponent.FItems\r
18063   else\r
18064     ParentItems := (Parent as TKOLMenuItem).FSubitems;\r
18065   I := ParentItems.IndexOf( Self );\r
18066   if I < ParentItems.Count - 1 then\r
18067   begin\r
18068     Tmp := ParentItems[ I + 1 ];\r
18069     ParentItems[ I + 1 ] := Self;\r
18070     ParentItems[ I ] := Tmp;\r
18071     Change;\r
18072   end;\r
18073 end;\r
18074 \r
18075 procedure TKOLMenuItem.DefProps(const Prefix: String; Filer: TFiler);\r
18076 var I: Integer;\r
18077     MI: TKOLMenuItem;\r
18078 begin\r
18079   asm\r
18080     jmp @@e_signature\r
18081     DB '#$signature$#', 0\r
18082     DB 'TKOLMenuItem.DefProps', 0\r
18083   @@e_signature:\r
18084   end;\r
18085   Filer.DefineProperty( Prefix + 'Name', LoadName, SaveName, True );\r
18086   Filer.DefineProperty( Prefix + 'Caption', LoadCaption, SaveCaption,  Caption <> '' );\r
18087   Filer.DefineProperty( Prefix + 'Enabled', LoadEnabled, SaveEnabled, True );\r
18088   Filer.DefineProperty( Prefix + 'Visible', LoadVisible, SaveVisible, True );\r
18089   Filer.DefineProperty( Prefix + 'Checked', LoadChecked, SaveChecked, True );\r
18090   Filer.DefineProperty( Prefix + 'RadioGroup', LoadRadioGroup, SaveRadioGroup, True );\r
18091   Filer.DefineProperty( Prefix + 'Separator', LoadSeparator, SaveSeparator, True );\r
18092   Filer.DefineProperty( Prefix + 'Accelerator', LoadAccel, SaveAccel, True );\r
18093   Filer.DefineProperty( Prefix + 'Bitmap', LoadBitmap, SaveBitmap, True );\r
18094   Filer.DefineProperty( Prefix + 'OnMenu', LoadOnMenu, SaveOnMenu, FOnMenuMethodName <> '' );\r
18095   Filer.DefineProperty( Prefix + 'SubItemCount', LoadSubItemCount, SaveSubItemCount, True );\r
18096   Filer.DefineProperty( Prefix + 'WindowMenu', LoadWindowMenu, SaveWindowMenu, True );\r
18097   Filer.DefineProperty( Prefix + 'HelpContext', LoadHelpContext, SaveHelpContext, HelpContext <> 0 );\r
18098   Filer.DefineProperty( Prefix + 'OwnerDraw', LoadOwnerDraw, SaveOwnerDraw, ownerDraw );\r
18099   Filer.DefineProperty( Prefix + 'MenuBreak', LoadMenuBreak, SaveMenuBreak, MenuBreak <> mbrNone );\r
18100   for I := 0 to FSubItemCount - 1 do\r
18101   begin\r
18102     if FSubItems.Count <= I then\r
18103       MI := TKOLMenuItem.Create( MenuComponent, Self, nil )\r
18104     else\r
18105       MI := FSubItems[ I ];\r
18106     MI.DefProps( Prefix + 'SubItem' + IntToStr( I ), Filer );\r
18107   end;\r
18108   Filer.DefineProperty( Prefix + 'Tag', LoadTag, SaveTag, Tag <> 0 );\r
18109   Filer.DefineProperty( Prefix + 'Default', LoadDefault, SaveDefault, Default );\r
18110 //  Filer.DefineProperty( Prefix + 'Action', LoadAction, SaveAction, FActionComponentName <> '');\r
18111 end;\r
18112 \r
18113 procedure TKOLMenuItem.LoadCaption(R: TReader);\r
18114 begin\r
18115   asm\r
18116     jmp @@e_signature\r
18117     DB '#$signature$#', 0\r
18118     DB 'TKOLMenuItem.LoadCaption', 0\r
18119   @@e_signature:\r
18120   end;\r
18121   FCaption := R.ReadString;\r
18122 end;\r
18123 \r
18124 procedure TKOLMenuItem.LoadChecked(R: TReader);\r
18125 begin\r
18126   asm\r
18127     jmp @@e_signature\r
18128     DB '#$signature$#', 0\r
18129     DB 'TKOLMenuItem.LoadChecked', 0\r
18130   @@e_signature:\r
18131   end;\r
18132   FChecked := R.ReadBoolean;\r
18133 end;\r
18134 \r
18135 procedure TKOLMenuItem.LoadEnabled(R: TReader);\r
18136 begin\r
18137   asm\r
18138     jmp @@e_signature\r
18139     DB '#$signature$#', 0\r
18140     DB 'TKOLMenuItem.LoadEnabled', 0\r
18141   @@e_signature:\r
18142   end;\r
18143   FEnabled := R.ReadBoolean;\r
18144 end;\r
18145 \r
18146 procedure TKOLMenuItem.LoadName(R: TReader);\r
18147 begin\r
18148   asm\r
18149     jmp @@e_signature\r
18150     DB '#$signature$#', 0\r
18151     DB 'TKOLMenuItem.LoadName', 0\r
18152   @@e_signature:\r
18153   end;\r
18154   Name := R.ReadString;\r
18155 end;\r
18156 \r
18157 procedure TKOLMenuItem.LoadOnMenu(R: TReader);\r
18158 begin\r
18159   asm\r
18160     jmp @@e_signature\r
18161     DB '#$signature$#', 0\r
18162     DB 'TKOLMenuItem.LoadOnMenu', 0\r
18163   @@e_signature:\r
18164   end;\r
18165   FOnMenuMethodName := R.ReadString;\r
18166 end;\r
18167 \r
18168 {procedure TKOLMenuItem.LoadRadioItem(R: TReader);\r
18169 begin\r
18170   asm\r
18171     jmp @@e_signature\r
18172     DB '#$signature$#', 0\r
18173     DB 'TKOLMenuItem.LoadRadioItem', 0\r
18174   @@e_signature:\r
18175   end;\r
18176   FRadioItem := R.ReadBoolean;\r
18177 end;}\r
18178 \r
18179 procedure TKOLMenuItem.LoadSubItemCount(R: TReader);\r
18180 begin\r
18181   asm\r
18182     jmp @@e_signature\r
18183     DB '#$signature$#', 0\r
18184     DB 'TKOLMenuItem.LoadSubItemCount', 0\r
18185   @@e_signature:\r
18186   end;\r
18187   FSubItemCount := R.ReadInteger;\r
18188 end;\r
18189 \r
18190 procedure TKOLMenuItem.LoadVisible(R: TReader);\r
18191 begin\r
18192   asm\r
18193     jmp @@e_signature\r
18194     DB '#$signature$#', 0\r
18195     DB 'TKOLMenuItem.LoadVisible', 0\r
18196   @@e_signature:\r
18197   end;\r
18198   FVisible := R.ReadBoolean;\r
18199 end;\r
18200 \r
18201 procedure TKOLMenuItem.SaveCaption(W: TWriter);\r
18202 begin\r
18203   asm\r
18204     jmp @@e_signature\r
18205     DB '#$signature$#', 0\r
18206     DB 'TKOLMenuItem.SaveCaption', 0\r
18207   @@e_signature:\r
18208   end;\r
18209   W.WriteString( Caption );\r
18210 end;\r
18211 \r
18212 procedure TKOLMenuItem.SaveChecked(W: TWriter);\r
18213 begin\r
18214   asm\r
18215     jmp @@e_signature\r
18216     DB '#$signature$#', 0\r
18217     DB 'TKOLMenuItem.SaveChecked', 0\r
18218   @@e_signature:\r
18219   end;\r
18220   W.WriteBoolean( Checked );\r
18221 end;\r
18222 \r
18223 procedure TKOLMenuItem.SaveEnabled(W: TWriter);\r
18224 begin\r
18225   asm\r
18226     jmp @@e_signature\r
18227     DB '#$signature$#', 0\r
18228     DB 'TKOLMenuItem.SaveEnabled', 0\r
18229   @@e_signature:\r
18230   end;\r
18231   W.WriteBoolean( Enabled );\r
18232 end;\r
18233 \r
18234 procedure TKOLMenuItem.SaveName(W: TWriter);\r
18235 begin\r
18236   asm\r
18237     jmp @@e_signature\r
18238     DB '#$signature$#', 0\r
18239     DB 'TKOLMenuItem.SaveName', 0\r
18240   @@e_signature:\r
18241   end;\r
18242   W.WriteString( Name );\r
18243 end;\r
18244 \r
18245 procedure TKOLMenuItem.SaveOnMenu(W: TWriter);\r
18246 begin\r
18247   asm\r
18248     jmp @@e_signature\r
18249     DB '#$signature$#', 0\r
18250     DB 'TKOLMenuItem.SaveOnMenu', 0\r
18251   @@e_signature:\r
18252   end;\r
18253   W.WriteString( FOnMenuMethodName );\r
18254 end;\r
18255 \r
18256 {procedure TKOLMenuItem.SaveRadioItem(W: TWriter);\r
18257 begin\r
18258   asm\r
18259     jmp @@e_signature\r
18260     DB '#$signature$#', 0\r
18261     DB 'TKOLMenuItem.SaveRadioItem', 0\r
18262   @@e_signature:\r
18263   end;\r
18264   W.WriteBoolean( FradioItem );\r
18265 end;}\r
18266 \r
18267 procedure TKOLMenuItem.SaveSubItemCount(W: TWriter);\r
18268 begin\r
18269   asm\r
18270     jmp @@e_signature\r
18271     DB '#$signature$#', 0\r
18272     DB 'TKOLMenuItem.SaveSubItemCount', 0\r
18273   @@e_signature:\r
18274   end;\r
18275   FSubItemCount := FSubItems.Count;\r
18276   W.WriteInteger( FSubItemCount );\r
18277 end;\r
18278 \r
18279 procedure TKOLMenuItem.SaveVisible(W: TWriter);\r
18280 begin\r
18281   asm\r
18282     jmp @@e_signature\r
18283     DB '#$signature$#', 0\r
18284     DB 'TKOLMenuItem.SaveVisible', 0\r
18285   @@e_signature:\r
18286   end;\r
18287   W.WriteBoolean( Visible );\r
18288 end;\r
18289 \r
18290 procedure TKOLMenuItem.LoadBitmap(R: TReader);\r
18291 var MS: TMemoryStream;\r
18292     SL: TStringList;\r
18293     S: String;\r
18294 begin\r
18295   asm\r
18296     jmp @@e_signature\r
18297     DB '#$signature$#', 0\r
18298     DB 'TKOLMenuItem.LoadBitmap', 0\r
18299   @@e_signature:\r
18300   end;\r
18301   MS := TMemoryStream.Create;\r
18302   SL := TStringList.Create;\r
18303   try\r
18304     R.ReadListBegin;\r
18305     while not R.EndOfList do\r
18306     begin\r
18307       S := R.ReadString;\r
18308       if Trim( S ) <> '' then\r
18309         SL.Add( Trim( S ) );\r
18310     end;\r
18311     R.ReadListEnd;\r
18312     if SL.Count = 0 then\r
18313     begin\r
18314       FBitmap.Width := 0;\r
18315       FBitmap.Height := 0;\r
18316     end\r
18317       else\r
18318     begin\r
18319       StrList2Binary( SL, MS );\r
18320       MS.Position := 0;\r
18321       FBitmap.LoadFromStream( MS );\r
18322     end;\r
18323   finally\r
18324     MS.Free;\r
18325     SL.Free;\r
18326   end;\r
18327 end;\r
18328 \r
18329 procedure TKOLMenuItem.SaveBitmap(W: TWriter);\r
18330 var MS: TMemoryStream;\r
18331     SL: TStringList;\r
18332     I: Integer;\r
18333 begin\r
18334   asm\r
18335     jmp @@e_signature\r
18336     DB '#$signature$#', 0\r
18337     DB 'TKOLMenuItem.SaveBitmap', 0\r
18338   @@e_signature:\r
18339   end;\r
18340   MS := TMemoryStream.Create;\r
18341   SL := TStringList.Create;\r
18342   try\r
18343     Bitmap.SaveToStream( MS );\r
18344     MS.Position := 0;\r
18345     if Bitmap.Width * Bitmap.Height > 0 then\r
18346       Binary2StrList( MS, SL );\r
18347     W.WriteListBegin;\r
18348     for I := 0 to SL.Count - 1 do\r
18349       W.WriteString( SL[ I ] );\r
18350     W.WriteListEnd;\r
18351   finally\r
18352     MS.Free;\r
18353     SL.Free;\r
18354   end;\r
18355 end;\r
18356 \r
18357 procedure TKOLMenuItem.SetupTemplate(SL: TStringList; FirstItem: Boolean);\r
18358     procedure Add2SL( const S: String );\r
18359     begin\r
18360       if Length( SL[ SL.Count - 1 ] + S ) > 64 then\r
18361         SL.Add( '      ' + S )\r
18362       else\r
18363         SL[ SL.Count - 1 ] := SL[ SL.Count - 1 ] + S;\r
18364     end;\r
18365 var S, U: String;\r
18366     I: Integer;\r
18367     MI: TKOLMenuItem;\r
18368 begin\r
18369   asm\r
18370     jmp @@e_signature\r
18371     DB '#$signature$#', 0\r
18372     DB 'TKOLMenuItem.SetupTemplate', 0\r
18373   @@e_signature:\r
18374   end;\r
18375   if Separator then\r
18376     S := '-'\r
18377   else\r
18378   begin\r
18379     U := Caption;\r
18380     if (U = '') or (Faction <> nil) then\r
18381       U := ' ';\r
18382     S := '';\r
18383     if FradioGroup <> 0 then\r
18384     begin\r
18385       S := '!' + S;\r
18386       if (FParent <> nil) and (FParent is TKOLMenuItem) then\r
18387       begin\r
18388         I := (FParent as TKOLMenuItem).FSubitems.IndexOf( Self );\r
18389         if I > 0 then\r
18390         begin\r
18391           MI := (FParent as TKOLMenuItem).FSubItems[ I - 1 ];\r
18392           if (MI.FradioGroup <> 0) and (MI.FradioGroup <> FradioGroup) then\r
18393             S := '!' + S;\r
18394         end;\r
18395       end;\r
18396       if not Checked then\r
18397         S := '-' + S;\r
18398     end;\r
18399     if Checked and (Faction = nil) then\r
18400       S := '+' + S;\r
18401   end;\r
18402   if Accelerator.Key <> vkNotPresent then\r
18403   if MenuComponent.showshortcuts and (Faction = nil) then\r
18404     U := U + #9 + Accelerator.AsText;\r
18405   if S = '' then\r
18406   begin\r
18407     if Faction = nil then\r
18408     S := PCharStringConstant( MenuComponent, Name, U )\r
18409   else\r
18410       S := '''' + U + '''';\r
18411   end\r
18412   else\r
18413   begin\r
18414     S := '''' + S + ''' + ';\r
18415     U := MenuComponent.StringConstant( Name, U );\r
18416     if (U <> '') and (U[ 1 ] <> '''') then\r
18417       S := 'PChar( ' + S + U + ')'\r
18418     else\r
18419       S := S + U;\r
18420   end;\r
18421   if not FirstItem then\r
18422     S := ', ' + S;\r
18423   Add2SL( S );\r
18424   if Count > 0 then\r
18425   begin\r
18426     Add2SL( ', ''(''' );\r
18427     for I := 0 to Count - 1 do\r
18428     begin\r
18429       MI := FSubItems[ I ];\r
18430       MI.SetupTemplate( SL, False );\r
18431     end;\r
18432     Add2SL( ', '')''' );\r
18433   end;\r
18434 end;\r
18435 \r
18436 procedure TKOLMenuItem.SetSeparator(const Value: Boolean);\r
18437 begin\r
18438   asm\r
18439     jmp @@e_signature\r
18440     DB '#$signature$#', 0\r
18441     DB 'TKOLMenuItem.SetSeparator', 0\r
18442   @@e_signature:\r
18443   end;\r
18444   FSeparator := Value;\r
18445   Change;\r
18446 end;\r
18447 \r
18448 procedure TKOLMenuItem.LoadSeparator(R: TReader);\r
18449 begin\r
18450   asm\r
18451     jmp @@e_signature\r
18452     DB '#$signature$#', 0\r
18453     DB 'TKOLMenuItem.LoadSeparator', 0\r
18454   @@e_signature:\r
18455   end;\r
18456   FSeparator := R.ReadBoolean;\r
18457 end;\r
18458 \r
18459 procedure TKOLMenuItem.SaveSeparator(W: TWriter);\r
18460 begin\r
18461   asm\r
18462     jmp @@e_signature\r
18463     DB '#$signature$#', 0\r
18464     DB 'TKOLMenuItem.SaveSeparator', 0\r
18465   @@e_signature:\r
18466   end;\r
18467   W.WriteBoolean( Separator );\r
18468 end;\r
18469 \r
18470 function TKOLMenuItem.GetItemIndex: Integer;\r
18471 var N: Integer;\r
18472   procedure IterateThroughSubItems( MI: TKOLMenuItem );\r
18473   var I: Integer;\r
18474   begin\r
18475     if MI = Self then\r
18476     begin\r
18477       Result := N;\r
18478       Exit;\r
18479     end;\r
18480     Inc( N );\r
18481     for I := 0 to MI.Count - 1 do\r
18482     begin\r
18483       IterateThroughSubItems( MI.FSubItems[ I ] );\r
18484       if Result >= 0 then break;\r
18485     end;\r
18486   end;\r
18487 var I: Integer;\r
18488 begin\r
18489   asm\r
18490     jmp @@e_signature\r
18491     DB '#$signature$#', 0\r
18492     DB 'TKOLMenuItem.GetItemIndex', 0\r
18493   @@e_signature:\r
18494   end;\r
18495   Result := -1;\r
18496   N := 0;\r
18497   if MenuComponent <> nil then\r
18498   for I := 0 to MenuComponent.Count - 1 do\r
18499   begin\r
18500     IterateThroughSubItems( MenuComponent.FItems[ I ] );\r
18501     if Result >= 0 then break;\r
18502   end;\r
18503 end;\r
18504 \r
18505 procedure TKOLMenuItem.SetItemIndex_Dummy(const Value: Integer);\r
18506 begin\r
18507   asm\r
18508     jmp @@e_signature\r
18509     DB '#$signature$#', 0\r
18510     DB 'TKOLMenuItem.SetItemIndex_Dummy', 0\r
18511   @@e_signature:\r
18512   end;\r
18513   // dummy method - nothing to set\r
18514 end;\r
18515 \r
18516 const VirtKeys: array[ TVirtualKey ] of String = (\r
18517   '0', 'VK_BACK', 'VK_TAB', 'VK_CLEAR', 'VK_RETURN', 'VK_PAUSE', 'VK_CAPITAL',\r
18518   'VK_ESCAPE', 'VK_SPACE', 'VK_PRIOR', 'VK_NEXT', 'VK_END', 'VK_HOME', 'VK_LEFT',\r
18519   'VK_UP', 'VK_RIGHT', 'VK_DOWN', 'VK_SELECT', 'VK_EXECUTE', 'VK_SNAPSHOT',\r
18520   'VK_INSERT', 'VK_DELETE', 'VK_HELP', '$30', '$31', '$32', '$33', '$34', '$35',\r
18521   '$36', '$37', '$38', '$39', '$41', '$42', '$43', '$44', '$45', '$46', '$47',\r
18522   '$48', '$49', '$4A', '$4B', '$4C', '$4D', '$4E', '$4F', '$50', '$51', '$52',\r
18523   '$53', '$54', '$55', '$56', '$57', '$58', '$59', '$5A', 'VK_LWIN', 'VK_RWIN', 'VK_APPS',\r
18524   'VK_NUMPAD0', 'VK_NUMPAD1', 'VK_NUMPAD2', 'VK_NUMPAD3', 'VK_NUMPAD4', 'VK_NUMPAD5',\r
18525   'VK_NUMPAD6', 'VK_NUMPAD7', 'VK_NUMPAD8', 'VK_NUMPAD9',  'VK_MULTIPLY', 'VK_ADD',\r
18526   'VK_SEPARATOR', 'VK_SUBTRACT', 'VK_DECIMAL', 'VK_DIVIDE', 'VK_F1', 'VK_F2', 'VK_F3',\r
18527   'VK_F4', 'VK_F5', 'VK_F6', 'VK_F7', 'VK_F8', 'VK_F9', 'VK_F10', 'VK_F11', 'VK_F12',\r
18528   'VK_F13', 'VK_F14', 'VK_F15', 'VK_F16', 'VK_F17', 'VK_F18', 'VK_F19', 'VK_F20',\r
18529   'VK_F21', 'VK_F22', 'VK_F23', 'VK_F24', 'VK_NUMLOCK', 'VK_SCROLL', 'VK_ATTN',\r
18530   'VK_CRSEL', 'VK_EXSEL', 'VK_EREOF', 'VK_PLAY', 'VK_ZOOM', 'VK_PA1', 'VK_OEMCLEAR' );\r
18531 \r
18532 // Maxim Pushkar:\r
18533 const VirtualKeyNames: array [TVirtualKey] of string =\r
18534              ( '', 'Back'{'BackSpace'}, 'Tab', 'CLEAR', 'Enter', 'Pause', 'CapsLock',\r
18535                  'Escape'{'Esc'}, 'Space', 'PageUp', 'PageDown', 'End', 'Home', 'Left',\r
18536                  'Up', 'Right', 'Down', 'SELECT', 'EXECUTE', 'PrintScreen',\r
18537                  'Ins', 'Delete'{'Del'}, 'Help'{'?'}, '0', '1', '2', '3', '4', '5',\r
18538                  '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',\r
18539                  'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T',\r
18540                  'U', 'V', 'W', 'X', 'Y', 'Z', 'LWin', 'RWin', 'APPS',\r
18541                  'Numpad0', 'Numpad1', 'Numpad2', 'Numpad3', 'Numpad4',\r
18542                  'Numpad5', 'Numpad6', 'Numpad7', 'Numpad8', 'Numpad9',\r
18543                  '*', '+', '|', '-', '.', '/', 'F1', 'F2', 'F3', 'F4',\r
18544                  'F5', 'F6', 'F7', 'F8', 'F9', 'F10', 'F11', 'F12', 'F13',\r
18545                  'F14', 'F15', 'F16', 'F17', 'F18', 'F19', 'F20', 'F21',\r
18546                  'F22', 'F23', 'F24', 'NumLock', 'ScrollLock', 'ATTN', 'CRSEL',\r
18547                  'EXSEL', 'EREOF', 'PLAY', 'ZOOM', 'PA1', 'OEMCLEAR');\r
18548 \r
18549 \r
18550 procedure TKOLMenuItem.SetupAttributes(SL: TStringList;\r
18551   const MenuName: String);\r
18552 const Breaks: array[ TMenuBreak ] of String = ( 'mbrNone', 'mbrBreak', 'mbrBarBreak' );\r
18553 var I: Integer;\r
18554     SI: TKOLMenuItem;\r
18555     RsrcName: String;\r
18556     S: String;\r
18557     F: TForm;\r
18558     FD: IFormDesigner;\r
18559 begin\r
18560   asm\r
18561     jmp @@e_signature\r
18562     DB '#$signature$#', 0\r
18563     DB 'TKOLMenuItem.SetupAttributes', 0\r
18564   @@e_signature:\r
18565   end;\r
18566   if not Enabled and (Faction = nil) then\r
18567     SL.Add( '    ' + MenuName + '.ItemEnabled[ ' + IntToStr( ItemIndex ) + ' ] := False;' );\r
18568   if not Visible and (Faction = nil) then\r
18569     SL.Add( '    ' + MenuName + '.ItemVisible[ ' + IntToStr( ItemIndex ) + ' ] := False;' );\r
18570   if (HelpContext <> 0) and (Faction = nil) then\r
18571     SL.Add( '    ' + MenuName + '.ItemHelpContext[ ' + IntToStr( ItemIndex ) + ' ] := ' +\r
18572             IntToStr( HelpContext ) + ';' );\r
18573   if (Bitmap <> nil) and (Bitmap.Width <> 0) and (Bitmap.Height <> 0) then\r
18574   begin\r
18575     RsrcName := MenuComponent.ParentForm.Name + '_' + Name + '_BMP';\r
18576     SL.Add( '    ' + MenuName + '.ItemBitmap[ ' + IntToStr( ItemIndex ) +\r
18577             ' ] := LoadBmp( hInstance, ''' + UpperCase( RsrcName + '_BITMAP' ) + ''', ' +\r
18578             MenuName + ' );' );\r
18579     SL.Add( '    {$R ' + RsrcName + '.res}' );\r
18580     GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName + '_BITMAP' ), RsrcName,\r
18581     MenuComponent.fUpdated );\r
18582   end;\r
18583   if (BitmapChecked <> nil) and (bitmapChecked.Width <> 0) and (bitmapChecked.Height <> 0) then\r
18584   begin\r
18585     RsrcName := MenuComponent.ParentForm.Name + '_' + Name + '_BMPCHECKED';\r
18586     SL.Add( '    ' + MenuName + '.Items[ ' + IntToStr( ItemIndex ) +\r
18587             ' ].BitmapChecked := LoadBmp( hInstance, ''' + UpperCase( RsrcName + '_BITMAP' ) + ''', ' +\r
18588             MenuName + ' );' );\r
18589     SL.Add( '    {$R ' + RsrcName + '.res}' );\r
18590     GenerateBitmapResource( bitmapChecked, UPPERCASE( RsrcName ), RsrcName,\r
18591     MenuComponent.fUpdated );\r
18592   end;\r
18593   if (BitmapItem <> nil) and (bitmapItem.Width <> 0) and (bitmapItem.Height <> 0) then\r
18594   begin\r
18595     RsrcName := MenuComponent.ParentForm.Name + '_' + Name + '_BMPITEM';\r
18596     SL.Add( '    ' + MenuName + '.Items[ ' + IntToStr( ItemIndex ) +\r
18597             ' ].BitmapChecked := LoadBmp( hInstance, ''' + UpperCase( RsrcName + '_BITMAP' ) + ''', ' +\r
18598             MenuName + ' );' );\r
18599     SL.Add( '    {$R ' + RsrcName + '.res}' );\r
18600     GenerateBitmapResource( bitmapItem, UPPERCASE( RsrcName ), RsrcName,\r
18601     MenuComponent.fUpdated );\r
18602   end;\r
18603   if FownerDraw then\r
18604     SL.Add( '    ' + MenuName + '.Items[ ' + IntToStr( ItemIndex ) +\r
18605             ' ].OwnerDraw := TRUE;' );\r
18606   if Fdefault then\r
18607     SL.Add( '    ' + MenuName + '.Items[ ' + IntToStr( ItemIndex ) +\r
18608             ' ].DefaultItem := TRUE;' );\r
18609   if FmenuBreak <> mbrNone then\r
18610     SL.Add( '    ' + MenuName + '.Items[ ' + IntToStr( ItemIndex ) +\r
18611             ' ].MenuBreak := ' + Breaks[ FmenuBreak ] + ';' );\r
18612   if FOnMenuMethodName <> '' then\r
18613   begin\r
18614     F := MenuComponent.ParentForm;\r
18615 //////////////////////////////////////////////////////////////////////////////////\r
18616   {$IFDEF _D6orHigher}                                                          //\r
18617     if (F <> nil) and (F.Designer <> nil) then                                  //\r
18618     begin                                                                       //\r
18619     F.Designer.QueryInterface( IDesigner, FD );                                 //\r
18620     if FD <>nil then                                                            //\r
18621     //if F.Designer.QueryInterface( IFormDesigner, FD ) = 0 then                //\r
18622     if FD.MethodExists( FOnMenuMethodName ) then                                //\r
18623       SL.Add( '    ' + MenuName + '.AssignEvents( ' + IntToStr( ItemIndex ) +   //\r
18624               ', [ Result.' + FOnMenuMethodName + ' ] );' );                    //\r
18625     end;                                                                        //\r
18626   {$ELSE}                                                                       //\r
18627 //////////////////////////////////////////////////////////////////////////////////\r
18628     if (F <> nil) and (F.Designer <> nil) then\r
18629     if QueryFormDesigner( F.Designer, FD ) then\r
18630     //if F.Designer.QueryInterface( IFormDesigner, FD ) = 0 then\r
18631     if FD.MethodExists( FOnMenuMethodName ) then\r
18632       SL.Add( '    ' + MenuName + '.AssignEvents( ' + IntToStr( ItemIndex ) +\r
18633               ', [ Result.' + FOnMenuMethodName + ' ] );' );\r
18634 //////////////////////////////////////////////////////////////////////////////////\r
18635   {$ENDIF}                                                                      //\r
18636 //////////////////////////////////////////////////////////////////////////////////\r
18637   end;\r
18638   if (Accelerator.Key <> vkNotPresent) and (Faction = nil) then\r
18639   begin\r
18640     S := 'FVIRTKEY';\r
18641     if kapShift in Accelerator.Prefix then\r
18642       S := S + ' or FSHIFT';\r
18643     if kapControl in Accelerator.Prefix then\r
18644       S := S + ' or FCONTROL';\r
18645     if kapAlt in Accelerator.Prefix then\r
18646       S := S + ' or FALT';\r
18647     if kapNoinvert in Accelerator.Prefix then\r
18648       S := S + ' or FNOINVERT';\r
18649     SL.Add( '    ' + MenuName + '.ItemAccelerator[ ' + IntToStr( ItemIndex ) +\r
18650             ' ] := MakeAccelerator( ' + S + ', ' + VirtKeys[ Accelerator.Key ] +\r
18651             ' );' );\r
18652   end;\r
18653   if Tag <> 0 then\r
18654     SL.Add( '    ' + MenuName + '.Items[' + IntToStr( ItemIndex ) +\r
18655             '].Tag := DWORD(' + IntToStr( Tag ) + ');' );\r
18656   for I := 0 to Count - 1 do\r
18657   begin\r
18658     SI := FSubItems[ I ];\r
18659     SI.SetupAttributes( SL, MenuName );\r
18660   end;\r
18661 end;\r
18662 \r
18663 procedure TKOLMenuItem.SetAccelerator(const Value: TKOLAccelerator);\r
18664 begin\r
18665   asm\r
18666     jmp @@e_signature\r
18667     DB '#$signature$#', 0\r
18668     DB 'TKOLMenuItem.SetAccelerator', 0\r
18669   @@e_signature:\r
18670   end;\r
18671   FAccelerator := Value;\r
18672   Change;\r
18673 end;\r
18674 \r
18675 procedure TKOLMenuItem.LoadAccel(R: TReader);\r
18676 var I: Integer;\r
18677 begin\r
18678   asm\r
18679     jmp @@e_signature\r
18680     DB '#$signature$#', 0\r
18681     DB 'TKOLMenuItem.LoadAccel', 0\r
18682   @@e_signature:\r
18683   end;\r
18684   I := R.ReadInteger;\r
18685   FAccelerator.Prefix := [ ];\r
18686   if LongBool(I and $100) then\r
18687     FAccelerator.Prefix := [ kapShift ];\r
18688   if LongBool(I and $200) then\r
18689     FAccelerator.Prefix := FAccelerator.Prefix + [ kapControl ];\r
18690   if LongBool(I and $400) then\r
18691     FAccelerator.Prefix := FAccelerator.Prefix + [ kapAlt ];\r
18692   if LongBool(I and $800) then\r
18693     Faccelerator.Prefix := FAccelerator.Prefix + [ kapNoinvert ];\r
18694   FAccelerator.Key := TVirtualKey( I and $FF );\r
18695 end;\r
18696 \r
18697 procedure TKOLMenuItem.LoadWindowMenu(R: TReader);\r
18698 begin\r
18699   asm\r
18700     jmp @@e_signature\r
18701     DB '#$signature$#', 0\r
18702     DB 'TKOLMenuItem.LoadWindowMenu', 0\r
18703   @@e_signature:\r
18704   end;\r
18705   FWindowMenu := R.ReadBoolean;\r
18706 end;\r
18707 \r
18708 procedure TKOLMenuItem.SaveWindowMenu(W: TWriter);\r
18709 begin\r
18710   asm\r
18711     jmp @@e_signature\r
18712     DB '#$signature$#', 0\r
18713     DB 'TKOLMenuItem.SaveWindowMenu', 0\r
18714   @@e_signature:\r
18715   end;\r
18716   W.WriteBoolean( FWindowMenu );\r
18717 end;\r
18718 \r
18719 procedure TKOLMenuItem.SaveAccel(W: TWriter);\r
18720 var I: Integer;\r
18721 begin\r
18722   asm\r
18723     jmp @@e_signature\r
18724     DB '#$signature$#', 0\r
18725     DB 'TKOLMenuItem.SaveAccel', 0\r
18726   @@e_signature:\r
18727   end;\r
18728   I := Ord( Accelerator.Key );\r
18729   if kapShift in Accelerator.Prefix then\r
18730     I := I or $100;\r
18731   if kapControl in Accelerator.Prefix then\r
18732     I := I or $200;\r
18733   if kapAlt in Accelerator.Prefix then\r
18734     I := I or $400;\r
18735   if kapNoinvert in Accelerator.Prefix then\r
18736     I := I or $800;\r
18737   W.WriteInteger( I );\r
18738 end;\r
18739 \r
18740 procedure TKOLMenuItem.DesignTimeClick;\r
18741 var F: TForm;\r
18742     D: IDesigner;\r
18743     FD: IFormDesigner;\r
18744     EvntName: String;\r
18745     TI: TTypeInfo;\r
18746     TD: TTypeData;\r
18747     Meth: TMethod;\r
18748 begin\r
18749   asm\r
18750     jmp @@e_signature\r
18751     DB '#$signature$#', 0\r
18752     DB 'TKOLMenuItem.DesignTimeClick', 0\r
18753   @@e_signature:\r
18754   end;\r
18755   Rpt( 'DesignTimeClick: ' + Caption );\r
18756   if Count > 0 then Exit;\r
18757   F := MenuComponent.ParentForm;\r
18758   if F = nil then Exit;\r
18759 //*///////////////////////////////////////////////////////\r
18760   {$IFDEF _D6orHigher}                                  //\r
18761         F.Designer.QueryInterface(IFormDesigner,D);     //\r
18762   {$ELSE}                                               //\r
18763 //*///////////////////////////////////////////////////////\r
18764         D := F.Designer;\r
18765 //*///////////////////////////////////////////////////////\r
18766   {$ENDIF}                                              //\r
18767 //*///////////////////////////////////////////////////////\r
18768   if D = nil then Exit;\r
18769   if not QueryFormDesigner( D, FD ) then Exit;\r
18770   //if D.QueryInterface( IFormDesigner, FD ) <> 0 then Exit;\r
18771   EvntName := FOnMenuMethodName;\r
18772   if EvntName = '' then\r
18773     EvntName := MenuComponent.ParentKOLForm.Name + Name + 'Menu';\r
18774   if FD.MethodExists( EvntName ) then\r
18775   begin\r
18776     FOnMenuMethodName := EvntName;\r
18777     FD.ShowMethod( EvntName );\r
18778     Change;\r
18779     Exit;\r
18780   end;\r
18781   TI.Kind := tkMethod;\r
18782   TI.Name := 'TOnMenuItem';\r
18783   TD.MethodKind := mkProcedure;\r
18784   TD.ParamCount := 2;\r
18785   TD.ParamList := 'Sender: PMenu; Item: Integer'#0#0;\r
18786   Meth := FD.CreateMethod( EvntName, {@TD} GetTypeData( TypeInfo( TOnMenuItem ) ) );\r
18787   if Meth.Code <> nil then\r
18788   begin\r
18789     FOnMenuMethodName := EvntName;\r
18790     FD.ShowMethod( EvntName );\r
18791     Change;\r
18792   end;\r
18793 end;\r
18794 \r
18795 procedure TKOLMenuItem.SetWindowMenu(Value: Boolean);\r
18796   procedure ClearWindowMenuForSubMenus( MI: TKOLMenuItem );\r
18797   var I: Integer;\r
18798       SMI: TKOLMenuItem;\r
18799   begin\r
18800     for I := 0 to MI.Count-1 do\r
18801     begin\r
18802       SMI := MI.SubItems[ I ];\r
18803       if SMI = Self then continue;\r
18804       SMI.WindowMenu := FALSE;\r
18805       ClearWindowMenuForSubMenus( SMI );\r
18806     end;\r
18807   end;\r
18808 var I: Integer;\r
18809     Menu: TKOLMenu;\r
18810     MI: TKOLMenuItem;\r
18811 begin\r
18812   asm\r
18813     jmp @@e_signature\r
18814     DB '#$signature$#', 0\r
18815     DB 'TKOLMenuItem.SetWindowMenu', 0\r
18816   @@e_signature:\r
18817   end;\r
18818   if csLoading in ComponentState then\r
18819     FWindowMenu := Value\r
18820   else\r
18821   begin\r
18822     Menu := MenuComponent;\r
18823     if (Menu = nil) or not(Menu is TKOLMainMenu) then\r
18824       Value := FALSE;\r
18825     if FWindowMenu = Value then Exit;\r
18826     FWindowMenu := Value;\r
18827     for I := 0 to Menu.Count-1 do\r
18828     begin\r
18829       MI := Menu.Items[ I ];\r
18830       if MI = Self then continue;\r
18831       MI.WindowMenu := FALSE;\r
18832       ClearWindowMenuForSubMenus( MI );\r
18833     end;\r
18834     Change;\r
18835   end;\r
18836 end;\r
18837 \r
18838 procedure TKOLMenuItem.SetHelpContext(const Value: Integer);\r
18839 begin\r
18840   if Faction = nil then\r
18841     FHelpContext := Value\r
18842   else\r
18843     FHelpContext := Faction.HelpContext;\r
18844   Change;\r
18845 end;\r
18846 \r
18847 procedure TKOLMenuItem.LoadHelpContext(R: TReader);\r
18848 begin\r
18849   FHelpContext := R.ReadInteger;\r
18850 end;\r
18851 \r
18852 procedure TKOLMenuItem.SaveHelpContext(W: TWriter);\r
18853 begin\r
18854   W.WriteInteger( FHelpContext );\r
18855 end;\r
18856 \r
18857 procedure TKOLMenuItem.LoadRadioGroup(R: TReader);\r
18858 begin\r
18859   FradioGroup := R.ReadInteger;\r
18860 end;\r
18861 \r
18862 procedure TKOLMenuItem.SaveRadioGroup(W: TWriter);\r
18863 begin\r
18864   W.WriteInteger( FradioGroup );\r
18865 end;\r
18866 \r
18867 procedure TKOLMenuItem.SetbitmapChecked(const Value: TBitmap);\r
18868 begin\r
18869   FbitmapChecked := Value;\r
18870   Change;\r
18871 end;\r
18872 \r
18873 procedure TKOLMenuItem.SetbitmapItem(const Value: TBitmap);\r
18874 begin\r
18875   FbitmapItem := Value;\r
18876   Change;\r
18877 end;\r
18878 \r
18879 procedure TKOLMenuItem.Setdefault(const Value: Boolean);\r
18880 begin\r
18881   Fdefault := Value;\r
18882   Change;\r
18883 end;\r
18884 \r
18885 procedure TKOLMenuItem.SetRadioGroup(const Value: Integer);\r
18886 begin\r
18887   FRadioGroup := Value;\r
18888   Change;\r
18889 end;\r
18890 \r
18891 procedure TKOLMenuItem.SetownerDraw(const Value: Boolean);\r
18892 begin\r
18893   FownerDraw := Value;\r
18894   Change;\r
18895 end;\r
18896 \r
18897 procedure TKOLMenuItem.LoadOwnerDraw(R: TReader);\r
18898 begin\r
18899   FownerDraw := R.ReadBoolean;\r
18900 end;\r
18901 \r
18902 procedure TKOLMenuItem.SaveOwnerDraw(W: TWriter);\r
18903 begin\r
18904   W.WriteBoolean( FownerDraw );\r
18905 end;\r
18906 \r
18907 procedure TKOLMenuItem.SetMenuBreak(const Value: TMenuBreak);\r
18908 begin\r
18909   FMenuBreak := Value;\r
18910   Change;\r
18911 end;\r
18912 \r
18913 procedure TKOLMenuItem.LoadMenuBreak(R: TReader);\r
18914 begin\r
18915   FmenuBreak := TMenuBreak( R.ReadInteger );\r
18916 end;\r
18917 \r
18918 procedure TKOLMenuItem.SaveMenuBreak(W: TWriter);\r
18919 begin\r
18920   W.WriteInteger( Integer( FmenuBreak ) );\r
18921 end;\r
18922 \r
18923 procedure TKOLMenuItem.SetTag(const Value: Integer);\r
18924 begin\r
18925   FTag := Value;\r
18926   Change;\r
18927 end;\r
18928 \r
18929 procedure TKOLMenuItem.LoadTag(R: TReader);\r
18930 begin\r
18931   FTag := R.ReadInteger;\r
18932 end;\r
18933 \r
18934 procedure TKOLMenuItem.SaveTag(W: TWriter);\r
18935 begin\r
18936   W.WriteInteger( FTag );\r
18937 end;\r
18938 \r
18939 procedure TKOLMenuItem.LoadDefault(R: TReader);\r
18940 begin\r
18941   Default := R.ReadBoolean;\r
18942 end;\r
18943 \r
18944 procedure TKOLMenuItem.SaveDefault(W: TWriter);\r
18945 begin\r
18946   W.WriteBoolean( Default );\r
18947 end;\r
18948 \r
18949 procedure TKOLMenuItem.Setaction(const Value: TKOLAction);\r
18950 begin\r
18951   if Faction = Value then exit;\r
18952   if Faction <> nil then\r
18953     Faction.UnLinkComponent(Self);\r
18954   Faction := Value;\r
18955   if Faction <> nil then\r
18956     Faction.LinkComponent(Self);\r
18957   Change;\r
18958 end;\r
18959 \r
18960 procedure TKOLMenuItem.Notification(AComponent: TComponent; Operation: TOperation);\r
18961 begin\r
18962   inherited;\r
18963   if Operation = opRemove then\r
18964     if AComponent = Faction then begin\r
18965       Faction.UnLinkComponent(Self);\r
18966       Faction := nil;\r
18967     end;\r
18968 end;\r
18969 \r
18970 procedure TKOLMenuItem.LoadAction(R: TReader);\r
18971 begin\r
18972 //  FActionComponentName:=R.ReadString;\r
18973 end;\r
18974 \r
18975 procedure TKOLMenuItem.SaveAction(W: TWriter);\r
18976 begin\r
18977 {\r
18978   if Faction <> nil then\r
18979     W.WriteString(Faction.GetNamePath)\r
18980   else\r
18981     W.WriteString('');\r
18982 }    \r
18983 end;\r
18984 \r
18985 { TKOLMenuEditor }\r
18986 \r
18987 procedure TKOLMenuEditor.Edit;\r
18988 var M: TKOLMenu;\r
18989     S: String;\r
18990 begin\r
18991   asm\r
18992     jmp @@e_signature\r
18993     DB '#$signature$#', 0\r
18994     DB 'TKOLMenuEditor.Edit', 0\r
18995   @@e_signature:\r
18996   end;\r
18997   if Component = nil then Exit;\r
18998   if not(Component is TKOLMenu) then Exit;\r
18999   M := Component as TKOLMenu;\r
19000   if M.ActiveDesign <> nil then\r
19001   begin\r
19002     M.ActiveDesign.MenuComponent := M;\r
19003     //M.ActiveDesign.Designer := Designer;\r
19004     M.ActiveDesign.Visible := True;\r
19005     SetForegroundWindow( M.ActiveDesign.Handle );\r
19006     M.ActiveDesign.MakeActive;\r
19007   end\r
19008      else\r
19009   begin\r
19010     M.ActiveDesign := TKOLMenuDesign.Create( Application );\r
19011     S := M.Name;\r
19012     if M.ParentKOLForm <> nil then\r
19013       S := M.ParentKOLForm.FormName + '.' + S;\r
19014     M.ActiveDesign.Caption := S;\r
19015     M.ActiveDesign.MenuComponent := M;\r
19016   end;\r
19017   if M.ParentForm <> nil then\r
19018     M.ParentForm.Invalidate;\r
19019 end;\r
19020 \r
19021 procedure TKOLMenuEditor.ExecuteVerb(Index: Integer);\r
19022 begin\r
19023   asm\r
19024     jmp @@e_signature\r
19025     DB '#$signature$#', 0\r
19026     DB 'TKOLMenuEditor.ExecuteVerb', 0\r
19027   @@e_signature:\r
19028   end;\r
19029   Edit;\r
19030 end;\r
19031 \r
19032 function TKOLMenuEditor.GetVerb(Index: Integer): string;\r
19033 begin\r
19034   asm\r
19035     jmp @@e_signature\r
19036     DB '#$signature$#', 0\r
19037     DB 'TKOLMenuEditor.GetVerb', 0\r
19038   @@e_signature:\r
19039   end;\r
19040   Result := '&Edit menu';\r
19041 end;\r
19042 \r
19043 function TKOLMenuEditor.GetVerbCount: Integer;\r
19044 begin\r
19045   asm\r
19046     jmp @@e_signature\r
19047     DB '#$signature$#', 0\r
19048     DB 'TKOLMenuEditor.GetVerbCount', 0\r
19049   @@e_signature:\r
19050   end;\r
19051   Result := 1;\r
19052 end;\r
19053 \r
19054 { TKOLMainMenu }\r
19055 \r
19056 procedure TKOLMainMenu.Change;\r
19057 begin\r
19058   asm\r
19059     jmp @@e_signature\r
19060     DB '#$signature$#', 0\r
19061     DB 'TKOLMainMenu.Change', 0\r
19062   @@e_signature:\r
19063   end;\r
19064   inherited;\r
19065   RebuildMenubar;\r
19066 end;\r
19067 \r
19068 constructor TKOLMainMenu.Create(AOwner: TComponent);\r
19069 var F: TForm;\r
19070     I: Integer;\r
19071     C: TComponent;\r
19072 begin\r
19073   asm\r
19074     jmp @@e_signature\r
19075     DB '#$signature$#', 0\r
19076     DB 'TKOLMainMenu.Create', 0\r
19077   @@e_signature:\r
19078   end;\r
19079   inherited;\r
19080   F := ParentForm;\r
19081   if F = nil then Exit;\r
19082   for I := 0 to F.ComponentCount - 1 do\r
19083   begin\r
19084     C := F.Components[ I ];\r
19085     if C = Self then continue;\r
19086     if C is TKOLMainMenu then\r
19087     begin\r
19088       ShowMessage(  'Another TKOLMainMenu component is already found on form ' +\r
19089                     F.Name + ' ( ' + C.Name + ' ). ' +\r
19090                     'Remember, please, that only one instance of TKOLMainMenu ' +\r
19091                     'should be placed on a form. Otherwise, code will be ' +\r
19092                     'generated only for one of those.' );\r
19093       Exit;\r
19094     end;\r
19095   end;\r
19096 end;\r
19097 \r
19098 var CommonOldWndProc: Pointer;\r
19099 function WndProcDesignMenu( Wnd: HWnd; uMsg: DWORD; wParam, lParam: Integer ): Integer;\r
19100          stdcall;\r
19101 var Id: Integer;\r
19102     M: HMenu;\r
19103     MII: TMenuItemInfo;\r
19104     KMI: TKOLMenuItem;\r
19105     C: TControl;\r
19106     F: TForm;\r
19107     I: Integer;\r
19108 begin\r
19109   asm\r
19110     jmp @@e_signature\r
19111     DB '#$signature$#', 0\r
19112     DB 'WndProcDesignMenu', 0\r
19113   @@e_signature:\r
19114   end;\r
19115   if (uMsg = WM_COMMAND)  then\r
19116   begin\r
19117     if (lParam = 0) and (HIWORD( wParam ) <= 1) then\r
19118     begin\r
19119       Id := LoWord( wParam );\r
19120       M := GetMenu( Wnd );\r
19121       if M <> 0 then\r
19122       begin\r
19123         Fillchar( MII, 44, 0 );\r
19124         MII.cbsize := 44;\r
19125         MII.fMask := MIIM_DATA;\r
19126         if GetMenuItemInfo( M, Id, False, MII ) then\r
19127         begin\r
19128           KMI := Pointer( MII.dwItemData );\r
19129           if KMI <> nil then\r
19130           begin\r
19131             try\r
19132               if KMI is TKOLMenuItem then\r
19133               begin\r
19134                 //Rpt( 'Click on ' + KMI.Caption );\r
19135                 KMI.DesignTimeClick;\r
19136                 Result := 0;\r
19137                 Exit;\r
19138               end;\r
19139             except\r
19140               on E: Exception do\r
19141               begin\r
19142                 ShowMessage( 'Design-time click failed, exception: ' + E.Message );\r
19143               end;\r
19144             end;\r
19145           end;\r
19146         end;\r
19147       end;\r
19148     end;\r
19149   end\r
19150     else\r
19151   if (uMsg = WM_DESTROY) then\r
19152   begin\r
19153     M := GetMenu( Wnd );\r
19154     SetMenu( Wnd, 0 );\r
19155     if M <> 0 then\r
19156     begin\r
19157       C := FindControl( Wnd );\r
19158       if (C <> nil) and (C is TForm) then\r
19159       begin\r
19160         F := C as TForm;\r
19161         for I := 0 to F.ComponentCount-1 do\r
19162           if F.Components[ I ] is TKOLMainMenu then\r
19163           begin\r
19164             DestroyMenu( M );\r
19165             (F.Components[ I ] as TKOLMainMenu).RestoreWndProc( Wnd );\r
19166             break;\r
19167           end;\r
19168       end\r
19169         else\r
19170       DestroyMenu( M );\r
19171     end;\r
19172   end;\r
19173   Result := CallWindowProc( CommonOldWndProc, Wnd, uMsg, wParam, lParam );\r
19174 end;\r
19175 \r
19176 destructor TKOLMainMenu.Destroy;\r
19177 var F: TForm;\r
19178     KF: TKOLForm;\r
19179     M: HMenu;\r
19180 begin\r
19181   asm\r
19182     jmp @@e_signature\r
19183     DB '#$signature$#', 0\r
19184     DB 'TKOLMainMenu.Destroy', 0\r
19185   @@e_signature:\r
19186   end;\r
19187   F := ParentForm;\r
19188   KF := nil;\r
19189   if F <> nil then\r
19190   begin\r
19191     KF := ParentKOLForm;\r
19192   end;\r
19193   if F <> nil then\r
19194   begin\r
19195     M := 0;\r
19196     if F.HandleAllocated then\r
19197     if F.Handle <> 0 then\r
19198     begin\r
19199       M := GetMenu( F.Handle );\r
19200       RestoreWndProc( F.Handle );\r
19201       SetMenu( F.Handle, 0 );\r
19202     end;\r
19203     if M <> 0 then\r
19204       DestroyMenu( M );\r
19205   end;\r
19206   inherited;\r
19207   if KF <> nil then\r
19208     KF.AlignChildren( nil, FALSE );\r
19209 end;\r
19210 \r
19211 procedure TKOLMainMenu.Loaded;\r
19212 //var KF: TKOLForm;\r
19213 begin\r
19214   asm\r
19215     jmp @@e_signature\r
19216     DB '#$signature$#', 0\r
19217     DB 'TKOLMainMenu.Loaded', 0\r
19218   @@e_signature:\r
19219   end;\r
19220   inherited;\r
19221   {KF := ParentKOLForm;\r
19222   if KF <> nil then\r
19223   begin\r
19224     KF.AllowRealign := TRUE;\r
19225     if not (csLoading in KF.ComponentState) then\r
19226       KF.AlignChildren( nil );\r
19227   end;}\r
19228 end;\r
19229 \r
19230 procedure TKOLMainMenu.RebuildMenubar;\r
19231 var F: TForm;\r
19232     M: HMenu;\r
19233     KMI: TKOLMenuItem;\r
19234     I: Integer;\r
19235 \r
19236     procedure BuildMenuItem( ParentMenu: HMenu; KMI: TKOLMenuItem );\r
19237     var MII: TMenuItemInfo;\r
19238         S: String;\r
19239         J: Integer;\r
19240     begin\r
19241       asm\r
19242         jmp @@e_signature\r
19243         DB '#$signature$#', 0\r
19244         DB 'TKOLMainMenu.RebuildMenubar.BuildMenuItem', 0\r
19245       @@e_signature:\r
19246       end;\r
19247       FillChar( MII, 44, 0 );\r
19248 \r
19249       if KMI.Separator then\r
19250         S := '-'\r
19251       else\r
19252       begin\r
19253         S := KMI.Caption;\r
19254         if S = '' then S := ' ';\r
19255         if showshortcuts and (KMI.Accelerator.Key <> vkNotPresent) then\r
19256           S := S + #9 + KMI.Accelerator.AsText;\r
19257       end;\r
19258 \r
19259       MII.cbSize := 44;\r
19260       MII.fMask := MIIM_DATA or MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE\r
19261                    or MIIM_CHECKMARKS;\r
19262       MII.dwItemData := Integer(KMI);\r
19263       if KMI.Separator then\r
19264       begin\r
19265         MII.fType := MFT_SEPARATOR;\r
19266         MII.fState := MFS_GRAYED;\r
19267       end\r
19268         else\r
19269       begin\r
19270         MII.fType := MFT_STRING;\r
19271         MII.dwTypeData := PChar( S );\r
19272         MII.cch := StrLen( PChar( S ) );\r
19273         if KMI.FradioGroup <> 0 then\r
19274         begin\r
19275           MII.fType := MII.fType or MFT_RADIOCHECK;\r
19276           //MII.dwItemData := MII.dwItemData or MIDATA_RADIOITEM;\r
19277         end;\r
19278         if KMI.Checked then\r
19279         begin\r
19280           //if not KMI.RadioItem then\r
19281           //  MII.dwItemData := MII.dwItemData or MIDATA_CHECKITEM;\r
19282           MII.fState := MII.fState or MFS_CHECKED;\r
19283         end;\r
19284         if not KMI.Enabled then\r
19285           MII.fState := MFS_GRAYED;\r
19286         if (KMI.Bitmap <> nil) and (KMI.Bitmap.Width * KMI.Bitmap.Height > 0) then\r
19287           MII.hBmpUnchecked := KMI.Bitmap.Handle;\r
19288         MII.wID := 100 + KMI.itemIndex;\r
19289         if KMI.Count > 0 then\r
19290         begin\r
19291           MII.hSubmenu := CreatePopupMenu;\r
19292           for J := 0 to KMI.Count - 1 do\r
19293             BuildMenuItem( MII.hSubMenu, KMI.FSubItems[ J ] );\r
19294         end;\r
19295       end;\r
19296       InsertMenuItem( ParentMenu, Cardinal(-1), True, MII );\r
19297     end;\r
19298 \r
19299 var oldM: HMenu;\r
19300     oldWndProc: Pointer;\r
19301     KF: TKOLForm;\r
19302 begin\r
19303   asm\r
19304     jmp @@e_signature\r
19305     DB '#$signature$#', 0\r
19306     DB 'TKOLMainMenu.RebuildMenubar', 0\r
19307   @@e_signature:\r
19308   end;\r
19309   if (csDestroying in ComponentState) then Exit;\r
19310   if FUpdateDisabled then\r
19311   begin\r
19312     FUpdateNeeded := TRUE;\r
19313     Exit;\r
19314   end;\r
19315   TRY\r
19316 \r
19317     F := ParentForm;\r
19318     if F = nil then Exit;\r
19319     oldM := GetMenu( F.Handle );\r
19320     F.Menu := nil;\r
19321 \r
19322     M := CreateMenu;\r
19323     for I := 0 to Count - 1 do\r
19324     begin\r
19325       KMI := FItems[ I ];\r
19326       BuildMenuItem( M, KMI );\r
19327     end;\r
19328     //F.Menu := M;\r
19329     SetMenu( F.Handle, M );\r
19330     if oldM <> 0 then\r
19331       DestroyMenu( oldM );\r
19332     Integer(oldWndProc) := GetWindowLong( F.Handle, GWL_WNDPROC );\r
19333     if oldWndProc <> @WndProcDesignMenu then\r
19334     begin\r
19335       Rpt( 'Reset WndProc (old: ' + IntToStr( Integer(oldWndProc) ) + ' )' );\r
19336       CommonOldWndProc := oldWndProc;\r
19337       FoldWndProc := oldWndProc;\r
19338       SetWindowLong( F.Handle, GWL_WNDPROC, Integer( @WndProcDesignMenu ) );\r
19339     end;\r
19340 \r
19341   FINALLY\r
19342     KF := ParentKOLForm;\r
19343     if KF <> nil then\r
19344     begin\r
19345       KF.AllowRealign := TRUE;\r
19346       if not (csLoading in KF.ComponentState) then\r
19347         KF.AlignChildren( nil, FALSE );\r
19348     end;\r
19349   END;\r
19350 end;\r
19351 \r
19352 procedure TKOLMainMenu.RestoreWndProc( Wnd: HWnd );\r
19353 var CurwndProc: Pointer;\r
19354 begin\r
19355   asm\r
19356     jmp @@e_signature\r
19357     DB '#$signature$#', 0\r
19358     DB 'TKOLMainMenu.RestoreWndProc', 0\r
19359   @@e_signature:\r
19360   end;\r
19361   Integer(CurWndProc) := GetWindowLong( Wnd, GWL_WNDPROC );\r
19362   if CurWndProc = @WndProcDesignMenu then\r
19363   begin\r
19364     SetWindowLong( Wnd, GWL_WNDPROC, Integer( CommonOldWndProc ) );\r
19365   end;\r
19366 end;\r
19367 \r
19368 procedure TKOLMainMenu.UpdateMenu;\r
19369 begin\r
19370   asm\r
19371     jmp @@e_signature\r
19372     DB '#$signature$#', 0\r
19373     DB 'TKOLMainMenu.UpdateMenu', 0\r
19374   @@e_signature:\r
19375   end;\r
19376   inherited;\r
19377   RebuildMenubar;\r
19378 end;\r
19379 \r
19380 { TKOLPopupMenu }\r
19381 \r
19382 procedure TKOLPopupMenu.AssignEvents(SL: TStringList; const AName: String);\r
19383 begin\r
19384   asm\r
19385     jmp @@e_signature\r
19386     DB '#$signature$#', 0\r
19387     DB 'TKOLPopupMenu.AssignEvents', 0\r
19388   @@e_signature:\r
19389   end;\r
19390   inherited;\r
19391   DoAssignEvents( SL, AName, [ 'OnPopup' ],\r
19392                              [ @ OnPopup ] );\r
19393 end;\r
19394 \r
19395 procedure TKOLPopupMenu.SetFlags(const Value: TPopupMenuFlags);\r
19396 begin\r
19397   FFlags := Value;\r
19398   Change;\r
19399 end;\r
19400 \r
19401 procedure TKOLPopupMenu.SetOnPopup(const Value: TOnEvent);\r
19402 begin\r
19403   asm\r
19404     jmp @@e_signature\r
19405     DB '#$signature$#', 0\r
19406     DB 'TKOLPopupMenu.SetOnPopup', 0\r
19407   @@e_signature:\r
19408   end;\r
19409   FOnPopup := Value;\r
19410   Change;\r
19411 end;\r
19412 \r
19413 procedure TKOLPopupMenu.SetupFirst(SL: TStringList; const AName, AParent,\r
19414   Prefix: String);\r
19415 var S: String;\r
19416 begin\r
19417   inherited;\r
19418   if Flags <> [ ] then\r
19419   begin\r
19420     if tpmVertical     in Flags then S := S + 'TPM_VERTICAL or ';\r
19421     if tpmRightButton  in Flags then S := S + 'TPM_RIGHTBUTTON or ';\r
19422     if tpmCenterAlign  in Flags then S := S + 'TPM_CENTERALIGN or ';\r
19423     if tpmRightAlign   in Flags then S := S + 'TPM_RIGHTALIGN or ';\r
19424     if tpmVCenterAlign in Flags then S := S + 'TPM_VCENTERALIGN or ';\r
19425     if tpmBottomAlign  in Flags then S := S + 'TPM_BOTTOMALIGN or ';\r
19426     if tpmHorPosAnimation in Flags then S := S + 'TPM_HORPOSANIMATION or ';\r
19427     if tpmHorNegAnimation in Flags then S := S + 'TPM_HORNEGANIMATION or ';\r
19428     if tpmVerPosAnimation in Flags then S := S + 'TPM_VERPOSANIMATION or ';\r
19429     if tpmVerNegAnimation in Flags then S := S + 'TPM_VERNEGANIMATION or ';\r
19430     if tpmNoAnimation in Flags then S := S + 'TPM_NOANIMATION or ';\r
19431     S := Copy(S,1,Length(S)-4);\r
19432     SL.Add( Prefix + AName + '.Flags := ' + S + ';' );\r
19433   end;\r
19434 end;\r
19435 \r
19436 { TKOLOnItemPropEditor }\r
19437 \r
19438 function TKOLOnItemPropEditor.GetValue: string;\r
19439 var Comp: TPersistent;\r
19440     F: TForm;\r
19441     D: IDesigner;\r
19442     FD: IFormDesigner;\r
19443 begin\r
19444   asm\r
19445     jmp @@e_signature\r
19446     DB '#$signature$#', 0\r
19447     DB 'TKOLOnItemPropEditor.GetValue', 0\r
19448   @@e_signature:\r
19449   end;\r
19450   Result := inherited GetValue;\r
19451   if Result = '' then\r
19452   begin\r
19453     Comp := GetComponent( 0 );\r
19454     if Comp <> nil then\r
19455     if Comp is TKOLMenuItem then\r
19456     begin\r
19457       Result := (Comp as TKOLMenuItem).FOnMenuMethodName;\r
19458       {\r
19459       if Result <> '' then\r
19460       begin\r
19461         Rpt( 'inherited OnMenu=NULL, but name is ' + Result + ', trying to restore correct value' );\r
19462         SetValue( Result );\r
19463         Result := inherited GetValue;\r
19464         Rpt( '--------- OnMenu=' + Result );\r
19465       end;\r
19466       }\r
19467     end;\r
19468   end;\r
19469   TRY\r
19470 \r
19471   Comp := GetComponent( 0 );\r
19472   if (Comp <> nil) and\r
19473      (Comp is TKOLMenuItem) and\r
19474      ((Comp as TKOLMenuItem).MenuComponent <> nil) then\r
19475   begin\r
19476     F := ((Comp as TKOLMenuItem).MenuComponent as TKOLMenu).ParentForm;\r
19477     if (F = nil) or (F.Designer = nil) then\r
19478     begin\r
19479       Result := ''; Exit;\r
19480     end;\r
19481 //*///////////////////////////////////////////////////////\r
19482   {$IFDEF _D6orHigher}                                  //\r
19483         F.Designer.QueryInterface(IFormDesigner,D);     //\r
19484   {$ELSE}                                               //\r
19485 //*///////////////////////////////////////////////////////\r
19486         D := F.Designer;\r
19487 //*///////////////////////////////////////////////////////\r
19488   {$ENDIF}                                              //\r
19489 //*///////////////////////////////////////////////////////\r
19490     if QueryFormDesigner( D, FD ) then\r
19491     //if D.QueryInterface( IFormDesigner, FD ) = 0 then\r
19492     begin\r
19493       if not FD.MethodExists( Result ) then Result := '';\r
19494     end\r
19495       else Result := '';\r
19496   end\r
19497     else Result := '';\r
19498 \r
19499   EXCEPT\r
19500     on E: Exception do\r
19501     begin\r
19502       Rpt( 'Exception while retrieving property OnMenu of TKOLMenuItem' );\r
19503       ShowMessage( 'Could not retrieve TKOLMenuItem.OnMenu, exception: ' + E.Message );\r
19504     end;\r
19505   END;\r
19506 end;\r
19507 \r
19508 procedure TKOLOnItemPropEditor.SetValue(const AValue: string);\r
19509 var Comp: TPersistent;\r
19510     I: Integer;\r
19511 begin\r
19512   asm\r
19513     jmp @@e_signature\r
19514     DB '#$signature$#', 0\r
19515     DB 'TKOLOnItemPropEditor.SetValue', 0\r
19516   @@e_signature:\r
19517   end;\r
19518   inherited;\r
19519   for I := 0 to PropCount - 1 do\r
19520   begin\r
19521     Comp := GetComponent( I );\r
19522     if Comp <> nil then\r
19523     if Comp is TKOLMenuItem then\r
19524     begin\r
19525       (Comp as TKOLMenuItem).FOnMenuMethodName := AValue;\r
19526       (Comp as TKOLMenuItem).Change;\r
19527     end;\r
19528   end;\r
19529 end;\r
19530 \r
19531 { TKOLAccelerator }\r
19532 \r
19533 function TKOLAccelerator.AsText: String;\r
19534 var S: String;\r
19535 begin\r
19536   asm\r
19537     jmp @@e_signature\r
19538     DB '#$signature$#', 0\r
19539     DB 'TKOLAccelerator.AsText', 0\r
19540   @@e_signature:\r
19541   end;\r
19542   Result:='';// {RA}\r
19543   if kapControl in Prefix then\r
19544     Result := 'Ctrl+';\r
19545   if kapAlt in Prefix then\r
19546     Result := Result + 'Alt+';\r
19547   if kapShift in Prefix then\r
19548     Result := Result + 'Shift+';\r
19549   {case Key of\r
19550   vkA..vkZ: S := Char(Ord(Key)-Ord(vkA)+Integer('A'));\r
19551   vk0..vk9: S := Char(Ord(Key)-Ord(vk0)+Integer('0'));\r
19552   vkF1..vkF24: S := 'F' + IntToStr( Ord(Key)-Ord(vkF1)+1 );\r
19553   vkDivide:   S := '/';\r
19554   vkMultiply: S := '*';\r
19555   vkSubtract: S := '-';\r
19556   vkAdd:      S := '+';\r
19557   vkNUM0..vkNUM9: S := 'Numpad' + IntToStr( Ord(Key)-Ord(vkNUM0) );\r
19558   vkNotPresent: S := '';\r
19559   else begin\r
19560          S := VirtKeys[ Key ];\r
19561          if Copy( S, 1, 3 ) = 'VK_' then\r
19562            S := CopyEnd( S, 4 );\r
19563        end;\r
19564   end;}\r
19565   S := VirtualKeyNames[Key]; // Maxim Pushkar\r
19566   if S = '' then Result := '' else Result := Result + S;\r
19567 end;\r
19568 \r
19569 procedure TKOLAccelerator.Change;\r
19570 begin\r
19571   asm\r
19572     jmp @@e_signature\r
19573     DB '#$signature$#', 0\r
19574     DB 'TKOLAccelerator.Change', 0\r
19575   @@e_signature:\r
19576   end;\r
19577   if FOwner is TKOLMenuItem then\r
19578     TKOLMenuItem(FOwner).Change\r
19579   else\r
19580   if FOwner is TKOLAction then\r
19581     TKOLAction(FOwner).Change;\r
19582 end;\r
19583 \r
19584 procedure TKOLAccelerator.SetKey(const Value: TVirtualKey);\r
19585 begin\r
19586   asm\r
19587     jmp @@e_signature\r
19588     DB '#$signature$#', 0\r
19589     DB 'TKOLAccelerator.SetKey', 0\r
19590   @@e_signature:\r
19591   end;\r
19592   FKey := Value;\r
19593   Change;\r
19594 end;\r
19595 \r
19596 procedure TKOLAccelerator.SetPrefix(const Value: TKOLAccPrefix);\r
19597 begin\r
19598   asm\r
19599     jmp @@e_signature\r
19600     DB '#$signature$#', 0\r
19601     DB 'TKOLAccelerator.SetPrefix', 0\r
19602   @@e_signature:\r
19603   end;\r
19604   FPrefix := Value;\r
19605   Change;\r
19606 end;\r
19607 \r
19608 { TKOLAccelearatorPropEditor }\r
19609 \r
19610 procedure TKOLAcceleratorPropEditor.Edit;\r
19611 var CAE: TKOLAccEdit;\r
19612     Comp: TPersistent;\r
19613 begin\r
19614   asm\r
19615     jmp @@e_signature\r
19616     DB '#$signature$#', 0\r
19617     DB 'TKOLAccelearatorPropEditor.Edit', 0\r
19618   @@e_signature:\r
19619   end;\r
19620   Comp := Getcomponent( 0 );\r
19621   if Comp = nil then Exit;\r
19622   if not ( Comp is TKOLMenuItem ) and not ( Comp is TKOLAction ) then Exit;\r
19623   CAE := TKOLAccEdit.Create( Application );\r
19624   try\r
19625     if Comp is TKOLMenuItem then\r
19626       with TKOLMenuItem(Comp) do\r
19627         CAE.Caption := CAE.Caption + MenuComponent.Name + '.' + Name\r
19628     else\r
19629     if Comp is TKOLAction then\r
19630       with TKOLAction(Comp) do\r
19631         CAE.Caption := CAE.Caption + ActionList.Name + '.' + Name;\r
19632         \r
19633     CAE.edAcc.Text := GetValue;\r
19634     CAE.ShowModal;\r
19635     if CAE.ModalResult = mrOK then\r
19636       SetValue( CAE.edAcc.Text );\r
19637   finally\r
19638     CAE.Free;\r
19639   end;\r
19640 end;\r
19641 \r
19642 function TKOLAcceleratorPropEditor.GetAttributes: TPropertyAttributes;\r
19643 begin\r
19644   asm\r
19645     jmp @@e_signature\r
19646     DB '#$signature$#', 0\r
19647     DB 'TKOLAcceleratorPropEditor.GetAttributes', 0\r
19648   @@e_signature:\r
19649   end;\r
19650   Result := [ paDialog {, pasubProperties} ];\r
19651 end;\r
19652 \r
19653 function TKOLAcceleratorPropEditor.GetValue: string;\r
19654 var Comp: TPersistent;\r
19655     MA: TKOLAccelerator;\r
19656 begin\r
19657   asm\r
19658     jmp @@e_signature\r
19659     DB '#$signature$#', 0\r
19660     DB 'TKOLAcceleratorPropEditor.GetValue', 0\r
19661   @@e_signature:\r
19662   end;\r
19663   Comp := GetComponent( 0 );\r
19664   if Comp is TKOLMenuItem then\r
19665     MA := (Comp as TKOLMenuItem).Accelerator\r
19666   else\r
19667   if Comp is TKOLAction then\r
19668     MA := (Comp as TKOLAction).Accelerator\r
19669   else\r
19670     MA := nil;\r
19671   if MA <> nil then\r
19672     Result := MA.AsText\r
19673   else\r
19674     Result := '';\r
19675 end;\r
19676 \r
19677 procedure TKOLAcceleratorPropEditor.SetValue(const Value: string);\r
19678 var Comp: TPersistent;\r
19679     MA: TKOLAccelerator;\r
19680     _Prefix: TKOLAccPrefix;\r
19681     _Key, K: TVirtualKey;\r
19682     S: String;\r
19683     I: Integer;\r
19684 begin\r
19685   asm\r
19686     jmp @@e_signature\r
19687     DB '#$signature$#', 0\r
19688     DB 'TKOLAcceleratorPropEditor.SetValue', 0\r
19689   @@e_signature:\r
19690   end;\r
19691   Comp := GetComponent( 0 );\r
19692   if Comp is TKOLMenuItem then\r
19693     MA := (Comp as TKOLMenuItem).Accelerator\r
19694   else\r
19695   if Comp is TKOLAction then\r
19696     MA := (Comp as TKOLAction).Accelerator\r
19697   else\r
19698     MA := nil;\r
19699   if MA <> nil then\r
19700   begin\r
19701     _Prefix := [ ];\r
19702     _Key := vkNotPresent;\r
19703     S := Value;\r
19704     for I := Length( S ) downto 1 do\r
19705       if S[ I ] <= ' ' then\r
19706         S := Copy( S, 1, I - 1 ) + Copy( S, I + 1, Length( S ) - I );\r
19707     while S <> '' do\r
19708     begin\r
19709       if UPPERCASE(Copy( S, 1, 6 )) = 'SHIFT+' then\r
19710       begin\r
19711         S := Copy( S, 7, Length(S)-6 );\r
19712         _Prefix := _Prefix + [ kapShift ];\r
19713         continue;\r
19714       end;\r
19715       if UPPERCASE(Copy( S, 1, 5 )) = 'CTRL+' then\r
19716       begin\r
19717         S := Copy( S, 6, Length(S)-5 );\r
19718         _Prefix := _Prefix + [ kapControl ];\r
19719         continue;\r
19720       end;\r
19721       if UPPERCASE(Copy( S, 1, 4 )) = 'ALT+' then\r
19722       begin\r
19723         S := Copy( S, 5, Length(S)-4 );\r
19724         _Prefix := _Prefix + [ kapAlt ];\r
19725         continue;\r
19726       end;\r
19727       _Key := vkNotPresent;\r
19728       //---------------------- { Maxim Pushkar } ----------------------\\r
19729       {if Length( S ) = 1 then                                          |\r
19730       case S[ 1 ] of                                                    |\r
19731       'A'..'Z': _Key := TVirtualKey( Ord(S[1])-Ord('A')+Ord(vkA) );     |\r
19732       '0'..'9': _Key := TVirtualKey( Ord(S[1])-Ord('0')+Ord(vk0) );     |\r
19733       '-': _Key := vkSubtract;                                          |\r
19734       '+': _Key := vkAdd;                                               |\r
19735       '/': _Key := vkDivide;                                            |\r
19736       '*': _Key := vkMultiply;                                          |\r
19737       ',': _Key := vkDecimal;                                           |\r
19738       else _Key := vkNotPresent;                                        |\r
19739       end                                                               |\r
19740         else                                                            |\r
19741       if Length( S ) > 1 then                                           |\r
19742       begin                                                             |\r
19743         if (S[ 1 ] = 'F') and (Str2Int(CopyEnd(S,2)) <> 0) then         |\r
19744           _Key := TVirtualKey( Ord(vkF1) - 1 + Str2Int(CopyEnd(S,2) ) ) |\r
19745         else                                                            |\r
19746         begin                                                           |\r
19747           for K := Low(TVirtualKey) to High(TVirtualKey) do             |\r
19748             if 'VK_' + UPPERCASE(S) = UPPERCASE(VirtKeys[ K ]) then     |\r
19749             begin                                                       |\r
19750               _Key := K;                                                |\r
19751               break;                                                   /|\r
19752             end;                                                      //\r
19753         end;                                                         //\r
19754       end;}                                                         //\r
19755       //++++++++++++++++++++++ Maxim Pushkar ++++++++++++++++++++++//\r
19756       for K := Low(TVirtualKey) to High(TVirtualKey) do           //\r
19757         if UpperCase(S) = UpperCase(VirtualKeyNames[K]) then     //\r
19758           _Key := K;                                            //\r
19759       //-------------------------------------------------------//\r
19760       break;\r
19761     end;\r
19762     if _Key = vkNotPresent then\r
19763     begin\r
19764       MA.Key := _Key;\r
19765       MA.Prefix := [ ];\r
19766     end\r
19767       else\r
19768     begin\r
19769       MA.Key := _Key;\r
19770       MA.Prefix := _Prefix;\r
19771     end;\r
19772   end\r
19773     else\r
19774     Beep;\r
19775 end;\r
19776 \r
19777 { TKOLBrush }\r
19778 \r
19779 procedure TKOLBrush.Assign(Value: TPersistent);\r
19780 var B: TKOLBrush;\r
19781 begin\r
19782   asm\r
19783     jmp @@e_signature\r
19784     DB '#$signature$#', 0\r
19785     DB 'TKOLBrush.Assign', 0\r
19786   @@e_signature:\r
19787   end;\r
19788   //inherited;\r
19789   if Value is TKOLBrush then\r
19790   begin\r
19791     B := Value as TKOLBrush;\r
19792     FColor := B.Color;\r
19793     FBrushStyle := B.BrushStyle;\r
19794     if B.FBitmap <> nil then\r
19795     begin\r
19796       if FBitmap = nil then\r
19797         FBitmap := TBitmap.Create;\r
19798       FBitmap.Assign( B.FBitmap )\r
19799     end\r
19800     else\r
19801     begin\r
19802       FBitmap.Free; FBitmap := nil;\r
19803     end;\r
19804     Change;\r
19805   end;\r
19806 end;\r
19807 \r
19808 procedure TKOLBrush.Change;\r
19809 var Form: TCustomForm;\r
19810 begin\r
19811   asm\r
19812     jmp @@e_signature\r
19813     DB '#$signature$#', 0\r
19814     DB 'TKOLBrush.Change', 0\r
19815   @@e_signature:\r
19816   end;\r
19817   if fOwner = nil then Exit;\r
19818   if fChangingNow then Exit;\r
19819   try\r
19820 \r
19821     if fOwner is TKOLForm then\r
19822     begin\r
19823       (fOwner as TKOLForm).Change( fOwner );\r
19824       if (fOwner as TKOLForm).Owner <> nil then\r
19825       begin\r
19826         Form := (fOwner as TKOLForm).Owner as TCustomForm;\r
19827         Form.Invalidate;\r
19828       end;\r
19829     end\r
19830     else\r
19831     if (fOwner is TKOLCustomControl) then\r
19832     begin\r
19833 {YS}\r
19834   {$IFDEF _KOLCtrlWrapper_}\r
19835       with (fOwner as TKOLCustomControl) do\r
19836         if Assigned(FKOLCtrl) then\r
19837           with FKOLCtrl^ do begin\r
19838             Brush.Color:=Self.Color;\r
19839             Brush.BrushStyle:=kol.TBrushStyle(BrushStyle);\r
19840 //            Brush.BrushBitmap:=Bitmap.Handle;\r
19841           end;\r
19842   {$ENDIF}\r
19843 {YS}\r
19844       (fOwner as TKOLCustomControl).Change;\r
19845       (fOwner as TKOLCustomControl).Invalidate;\r
19846      end\r
19847      else\r
19848        if (fOwner is TKOLObj) then\r
19849          (fOwner as TKOLObj).Change;\r
19850 \r
19851   finally\r
19852     fChangingNow := FALSE;\r
19853   end;\r
19854 end;\r
19855 \r
19856 constructor TKOLBrush.Create(AOwner: TComponent);\r
19857 begin\r
19858   inherited Create;\r
19859   FOwner := AOwner;\r
19860   FBitmap := TBitmap.Create;\r
19861   FColor := clBtnFace;\r
19862 end;\r
19863 \r
19864 destructor TKOLBrush.Destroy;\r
19865 begin\r
19866   FBitmap.Free;\r
19867   inherited;\r
19868 end;\r
19869 \r
19870 procedure TKOLBrush.GenerateCode(SL: TStrings; const AName: String);\r
19871 const\r
19872   BrushStyles: array[ TBrushStyle ] of String = ( 'bsSolid', 'bsClear', 'bsHorizontal', 'bsVertical',\r
19873     'bsFDiagonal', 'bsBDiagonal', 'bsCross', 'bsDiagCross' );\r
19874 var RsrcName: String;\r
19875     Updated: Boolean;\r
19876 begin\r
19877   if FOwner = nil then Exit;\r
19878   if FOwner is TKOLForm then\r
19879   begin\r
19880     if Bitmap.Empty then\r
19881     begin\r
19882       case BrushStyle of\r
19883       bsSolid: if (FOwner as TKOLForm).Color <> clBtnFace then\r
19884                  SL.Add( '    ' + AName + '.Color := ' + Color2Str( (FOwner as TKOLForm).Color ) + ';' );\r
19885       else SL.Add( '    ' + AName + '.Brush.BrushStyle := ' + BrushStyles[ BrushStyle ] + ';' );\r
19886       end;\r
19887     end\r
19888       else\r
19889     begin\r
19890       RsrcName := (FOwner as TKOLForm).Owner.Name + '_' +\r
19891                   (FOwner as TKOLForm).Name + '_BRUSH_BMP';\r
19892       SL.Add( '    {$R ' + RsrcName + '.res}' );\r
19893       GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName ), RsrcName, Updated );\r
19894       SL.Add( '    ' + AName + '.Brush.BrushBitmap := LoadBmp( hInstance, ''' + UpperCase( RsrcName )\r
19895               + ''', Result );' );\r
19896     end;\r
19897   end\r
19898     else\r
19899   if FOwner is TKOLCustomControl then\r
19900   begin\r
19901     if Bitmap.Empty then\r
19902     begin\r
19903       case BrushStyle of\r
19904       bsSolid: if not (FOwner as TKOLCustomControl).ParentColor then\r
19905                  SL.Add( '    ' + AName + '.Color := ' + Color2Str( (FOwner as TKOLForm).Color ) + ';' );\r
19906       else SL.Add( '    ' + AName + '.Brush.BrushStyle := ' + BrushStyles[ BrushStyle ] + ';' );\r
19907       end;\r
19908     end\r
19909       else\r
19910     begin\r
19911       RsrcName := (FOwner as TKOLCustomControl).ParentForm.Name + '_' +\r
19912                   (FOwner as TKOLCustomControl).Name + '_BRUSH_BMP';\r
19913       SL.Add( '    {$R ' + RsrcName + '.res}' );\r
19914       GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName ), RsrcName, Updated );\r
19915       SL.Add( '    ' + AName + '.Brush.BrushBitmap := LoadBmp( hInstance, ''' + UpperCase( RsrcName )\r
19916               + ''', Result );' );\r
19917     end;\r
19918   end;\r
19919 end;\r
19920 \r
19921 procedure TKOLBrush.SetBitmap(const Value: TBitmap);\r
19922 begin\r
19923   FBitmap.Assign(Value);\r
19924   if FOwner <> nil then\r
19925     if FOwner is TKOLForm then\r
19926     begin\r
19927       {if (FOwner as TKOLForm).Owner <> nil then\r
19928         ((FOwner as TKOLForm).Owner as TCustomForm).Brush.Bitmap.Assign( Value );}\r
19929     end;\r
19930   Change;\r
19931 end;\r
19932 \r
19933 procedure TKOLBrush.SetBrushStyle(const Value: TBrushStyle);\r
19934 begin\r
19935   if FBrushStyle = Value then Exit;\r
19936   FBrushStyle := Value;\r
19937   if FOwner <> nil then\r
19938     if FOwner is TKOLForm then\r
19939     begin\r
19940       if (FOwner as TKOLForm).Owner <> nil then\r
19941         ((Fowner as TKOLForm).Owner as TCustomForm).Brush.Style :=\r
19942         Graphics.TBrushStyle( Value );\r
19943     end;\r
19944   Change;\r
19945 end;\r
19946 \r
19947 procedure TKOLBrush.SetColor(const Value: TColor);\r
19948 begin\r
19949   if FColor = Value then Exit;\r
19950   FColor := Value;\r
19951   if FOwner <> nil then\r
19952     if FOwner is TKOLForm then\r
19953       (FOwner as TKOLForm).Color := Value\r
19954     else\r
19955     if FOwner is TKOLCustomControl then\r
19956       (FOwner as TKOLCustomControl).Color := Value;\r
19957   Change;\r
19958 end;\r
19959 \r
19960 { TKOLAction }\r
19961 \r
19962 procedure TKOLAction.Assign(Source: TPersistent);\r
19963 begin\r
19964   if Source is TKOLAction then\r
19965   begin\r
19966     FCaption := TKOLAction(Source).FCaption;\r
19967     FHint := TKOLAction(Source).FHint;\r
19968     FChecked := TKOLAction(Source).FChecked;\r
19969     FEnabled := TKOLAction(Source).FEnabled;\r
19970     FVisible := TKOLAction(Source).FVisible;\r
19971     FHelpContext := TKOLAction(Source).FHelpContext;\r
19972     FOnExecute := TKOLAction(Source).FOnExecute;\r
19973 \r
19974   end\r
19975   else\r
19976     inherited Assign(Source);\r
19977 end;\r
19978 \r
19979 constructor TKOLAction.Create(AOwner: TComponent);\r
19980 begin\r
19981   inherited Create(AOwner);\r
19982   FLinked:=TStringList.Create;\r
19983   FAccelerator:=TKOLAccelerator.Create;\r
19984   FAccelerator.FOwner:=Self;\r
19985   FVisible:=True;\r
19986   FEnabled:=True;\r
19987   NeedFree:=False;\r
19988 end;\r
19989 \r
19990 procedure TKOLAction.DefineProperties(Filer: TFiler);\r
19991 begin\r
19992   inherited;\r
19993   Filer.DefineProperty('Links', LoadLinks, SaveLinks, FLinked.Count > 0);\r
19994 end;\r
19995 \r
19996 destructor TKOLAction.Destroy;\r
19997 begin\r
19998   inherited;\r
19999   if FActionList <> nil then\r
20000     FActionList.List.Remove(Self);\r
20001   FLinked.Free;\r
20002   FAccelerator.Free;\r
20003 end;\r
20004 \r
20005 function TKOLAction.GetIndex: Integer;\r
20006 begin\r
20007   if ActionList <> nil then\r
20008     Result := ActionList.List.IndexOf(Self)\r
20009   else\r
20010     Result := -1;\r
20011 end;\r
20012 \r
20013 function TKOLAction.GetParentComponent: TComponent;\r
20014 begin\r
20015   if FActionList <> nil then\r
20016     Result := FActionList\r
20017   else\r
20018     Result := inherited GetParentComponent;\r
20019 end;\r
20020 \r
20021 function TKOLAction.HasParent: Boolean;\r
20022 begin\r
20023   if FActionList <> nil then\r
20024     Result := True\r
20025   else\r
20026     Result := inherited HasParent;\r
20027 end;\r
20028 \r
20029 procedure TKOLAction.LinkComponent(const AComponent: TComponent);\r
20030 begin\r
20031   ResolveLinks;\r
20032   if (FLinked.IndexOfObject(AComponent) = -1) and\r
20033      (FLinked.IndexOf(GetComponentFullPath(AComponent)) = -1) then\r
20034   begin\r
20035     FLinked.AddObject('', AComponent);\r
20036     AComponent.FreeNotification(Self); // 1.87 +YS\r
20037     UpdateLinkedComponent(AComponent);\r
20038   end;\r
20039 end;\r
20040 \r
20041 procedure TKOLAction.Loaded;\r
20042 begin\r
20043   inherited;\r
20044   ResolveLinks;\r
20045 end;\r
20046 \r
20047 procedure TKOLAction.LoadLinks(R: TReader);\r
20048 begin\r
20049   R.ReadListBegin;\r
20050   while not R.EndOfList do\r
20051     FLinked.Add(R.ReadString);\r
20052   R.ReadListEnd;\r
20053 end;\r
20054 \r
20055 procedure TKOLAction.ReadState(Reader: TReader);\r
20056 begin\r
20057   inherited ReadState(Reader);\r
20058   if Reader.Parent is TKOLActionList then begin\r
20059     ActionList := TKOLActionList(Reader.Parent);\r
20060   end;\r
20061 end;\r
20062 \r
20063 procedure TKOLAction.ResolveLinks;\r
20064 var\r
20065   i: integer;\r
20066   s: string;\r
20067   c: TComponent;\r
20068 begin\r
20069   for i:=0 to FLinked.Count - 1 do begin\r
20070     s:=FLinked[i];\r
20071     if s <> '' then begin\r
20072       c:=FindComponentByPath(s);\r
20073       if c <> nil then begin\r
20074         FLinked[i]:='';\r
20075         FLinked.Objects[i]:=c;\r
20076         if c is TKOLMenuItem then\r
20077           TKOLMenuItem(c).action:=Self\r
20078         else\r
20079         if c is TKOLCustomControl then\r
20080           TKOLCustomControl(c).action:=Self\r
20081         else\r
20082         if c is TKOLToolbarButton then\r
20083           TKOLToolbarButton(c).action:=Self;\r
20084         c.FreeNotification(Self); // v1.87 YS\r
20085         UpdateLinkedComponent(c);\r
20086       end;\r
20087     end;\r
20088   end;\r
20089 end;\r
20090 \r
20091 procedure TKOLAction.SaveLinks(W: TWriter);\r
20092 var\r
20093   i: integer;\r
20094   s: string;\r
20095 begin\r
20096   W.WriteListBegin;\r
20097   for i:=0 to FLinked.Count - 1 do begin\r
20098     s:=FLinked[i];\r
20099     if (s = '') and (FLinked.Objects[i] <> nil) then\r
20100       s:=GetComponentFullPath(TComponent(FLinked.Objects[i]));\r
20101     if s <> '' then\r
20102       W.WriteString(s);\r
20103   end;\r
20104   W.WriteListEnd;\r
20105 end;\r
20106 \r
20107 procedure TKOLAction.SetActionList(const Value: TKOLActionList);\r
20108 begin\r
20109   if FActionList = Value then exit;\r
20110   FActionList := Value;\r
20111   if FActionList <> nil then\r
20112     FActionList.List.Add(Self);\r
20113 end;\r
20114 \r
20115 procedure TKOLAction.SetCaption(const Value: string);\r
20116 begin\r
20117   if FCaption = Value then exit;\r
20118   FCaption := Value;\r
20119   UpdateLinkedComponents;\r
20120   Change;\r
20121 end;\r
20122 \r
20123 procedure TKOLAction.SetChecked(const Value: boolean);\r
20124 begin\r
20125   if FChecked = Value then exit;\r
20126   FChecked := Value;\r
20127   UpdateLinkedComponents;\r
20128   Change;\r
20129 end;\r
20130 \r
20131 procedure TKOLAction.SetEnabled(const Value: boolean);\r
20132 begin\r
20133   if Enabled = Value then exit;\r
20134   FEnabled := Value;\r
20135   UpdateLinkedComponents;\r
20136   Change;\r
20137 end;\r
20138 \r
20139 procedure TKOLAction.SetHelpContext(const Value: integer);\r
20140 begin\r
20141   if FHelpContext = Value then exit;\r
20142   FHelpContext := Value;\r
20143   UpdateLinkedComponents;\r
20144   Change;\r
20145 end;\r
20146 \r
20147 procedure TKOLAction.SetHint(const Value: string);\r
20148 begin\r
20149   if FHint = Value then exit;\r
20150   FHint := Value;\r
20151   UpdateLinkedComponents;\r
20152   Change;\r
20153 end;\r
20154 \r
20155 procedure TKOLAction.SetIndex(Value: Integer);\r
20156 var\r
20157   CurIndex, Count: Integer;\r
20158 begin\r
20159   CurIndex := GetIndex;\r
20160   if CurIndex >= 0 then\r
20161   begin\r
20162     Count := ActionList.FActions.Count;\r
20163     if Value < 0 then Value := 0;\r
20164     if Value >= Count then Value := Count - 1;\r
20165     if Value <> CurIndex then\r
20166     begin\r
20167       ActionList.FActions.Delete(CurIndex);\r
20168       ActionList.FActions.Insert(Value, Self);\r
20169     end;\r
20170   end;\r
20171 end;\r
20172 \r
20173 procedure TKOLAction.SetName(const NewName: TComponentName);\r
20174 begin\r
20175   inherited;\r
20176   if Assigned(ActionList) and Assigned(ActionList.ActiveDesign) then\r
20177     ActionList.ActiveDesign.NameChanged(Self);\r
20178 end;\r
20179 \r
20180 procedure TKOLAction.SetOnExecute(const Value: TOnEvent);\r
20181 begin\r
20182   if @FOnExecute = @Value then exit;\r
20183   FOnExecute := Value;\r
20184   Change;\r
20185 end;\r
20186 \r
20187 procedure TKOLAction.SetParentComponent(AParent: TComponent);\r
20188 begin\r
20189   if not (csLoading in ComponentState) and (AParent is TKOLActionList) then\r
20190     ActionList := TKOLActionList(AParent);\r
20191 end;\r
20192 \r
20193 procedure TKOLAction.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String);\r
20194 begin\r
20195 end;\r
20196 \r
20197 procedure TKOLAction.SetVisible(const Value: boolean);\r
20198 begin\r
20199   if FVisible = Value then exit;\r
20200   FVisible := Value;\r
20201   UpdateLinkedComponents;\r
20202   Change;\r
20203 end;\r
20204 \r
20205 procedure TKOLAction.UnLinkComponent(const AComponent: TComponent);\r
20206 var\r
20207   i: integer;\r
20208 begin\r
20209   ResolveLinks;\r
20210   while True do begin\r
20211     i:=FLinked.IndexOfObject(AComponent);\r
20212     if i <> -1 then\r
20213       FLinked.Delete(i)\r
20214     else\r
20215       break;  \r
20216   end;\r
20217 end;\r
20218 \r
20219 function TKOLAction.FindComponentByPath(const Path: string): TComponent;\r
20220 var\r
20221   i, j: integer;\r
20222   p, n: string;\r
20223 begin\r
20224   p:=Path;\r
20225   Result:=nil;\r
20226   repeat\r
20227     i:=Pos('.', p);\r
20228     if i = 0 then\r
20229       i:=Length(p) + 1;\r
20230     n:=Copy(p, 1, i - 1);\r
20231     p:=Copy(p, i + 1, MaxInt);\r
20232     if Result = nil then begin\r
20233       for j:=0 to Screen.FormCount - 1 do\r
20234         if AnsiCompareText(Screen.Forms[j].Name, n) = 0 then begin\r
20235           Result:=Screen.Forms[j];\r
20236           break;\r
20237         end;\r
20238     end\r
20239     else\r
20240       Result:=Result.FindComponent(n);\r
20241 \r
20242 //    if Result <> nil then\r
20243 //      Rpt('Found: ' + Result.Name);\r
20244   until (p = '') or (Result = nil);\r
20245 end;\r
20246 \r
20247 function TKOLAction.GetComponentFullPath(AComponent: TComponent): string;\r
20248 begin\r
20249   Result:='';\r
20250   while AComponent <> nil do begin\r
20251     if Result <> '' then\r
20252       Result:='.' + Result;\r
20253     Result:=AComponent.Name + Result;\r
20254     AComponent:=AComponent.Owner;\r
20255   end;\r
20256 end;\r
20257 \r
20258 procedure TKOLAction.UpdateLinkedComponents;\r
20259 var\r
20260   i: integer;\r
20261 begin\r
20262   for i:=0 to FLinked.Count - 1 do\r
20263     UpdateLinkedComponent(TComponent(FLinked.Objects[i]));\r
20264 end;\r
20265 \r
20266 procedure TKOLAction.UpdateLinkedComponent(AComponent: TComponent);\r
20267 begin\r
20268   if AComponent is TKOLMenuItem then\r
20269     with TKOLMenuItem(AComponent) do begin\r
20270       if Self.FAccelerator.Key <> vkNotPresent then\r
20271         FCaption:=Self.FCaption + #9 + Self.FAccelerator.AsText\r
20272       else\r
20273         FCaption:=Self.FCaption;\r
20274       FVisible:=Self.FVisible;\r
20275       FEnabled:=Self.FEnabled;\r
20276       FChecked:=Self.FChecked;\r
20277       FHelpContext:=Self.FHelpContext;\r
20278       Change;\r
20279     end\r
20280   else\r
20281   if AComponent is TKOLCustomControl then begin\r
20282     with TKOLCustomControl(AComponent) do begin\r
20283       Caption:=Self.FCaption;\r
20284       Visible:=Self.FVisible;\r
20285       Enabled:=Self.FEnabled;\r
20286       HelpContext:=Self.FHelpContext;\r
20287       Change;\r
20288     end;\r
20289     if AComponent is TKOLCheckBox then\r
20290       with TKOLCheckBox(AComponent) do begin\r
20291         Checked:=Self.FChecked;\r
20292       end\r
20293     else\r
20294     if AComponent is TKOLRadioBox then\r
20295       with TKOLRadioBox(AComponent) do begin\r
20296         Checked:=Self.FChecked;\r
20297       end;\r
20298   end\r
20299   else\r
20300   if AComponent is TKOLToolbarButton then\r
20301     with TKOLToolbarButton(AComponent) do begin\r
20302       Caption:=Self.FCaption;\r
20303       Visible:=Self.FVisible;\r
20304       Enabled:=Self.FEnabled;\r
20305       Checked:=Self.FChecked;\r
20306       HelpContext:=Self.FHelpContext;\r
20307       tooltip:=Self.FHint;\r
20308       Change;\r
20309     end\r
20310   else\r
20311 end;\r
20312 \r
20313 procedure TKOLAction.Notification(AComponent: TComponent; Operation: TOperation);\r
20314 begin\r
20315   inherited;\r
20316   if Operation = opRemove then\r
20317     UnLinkComponent(AComponent);\r
20318 end;\r
20319 \r
20320 procedure TKOLAction.SetAccelerator(const Value: TKOLAccelerator);\r
20321 begin\r
20322   if (FAccelerator.Prefix = Value.Prefix) and (FAccelerator.Key = Value.Key) then exit;\r
20323   FAccelerator := Value;\r
20324   UpdateLinkedComponents;\r
20325   Change;\r
20326 end;\r
20327 \r
20328 { TKOLActionList }\r
20329 \r
20330 procedure TKOLActionList.AssignEvents(SL: TStringList; const AName: String);\r
20331 begin\r
20332   inherited;\r
20333   DoAssignEvents(SL, AName, ['OnUpdateActions'], [@OnUpdateActions]);\r
20334 end;\r
20335 \r
20336 constructor TKOLActionList.Create(AOwner: TComponent);\r
20337 begin\r
20338   inherited;\r
20339   FActions:=TList.Create;\r
20340 end;\r
20341 \r
20342 destructor TKOLActionList.Destroy;\r
20343 begin\r
20344   ActiveDesign.Free;\r
20345   FActions.Free;\r
20346   inherited;\r
20347 end;\r
20348 \r
20349 procedure TKOLActionList.GetChildren(Proc: TGetChildProc {$IFDEF _D3orHigher} ; Root: TComponent {$ENDIF});\r
20350 var\r
20351   I: Integer;\r
20352   Action: TKOLAction;\r
20353 begin\r
20354   for I := 0 to FActions.Count - 1 do\r
20355   begin\r
20356     Action := FActions[I];\r
20357     {if Action.Owner = Root then }Proc(Action);\r
20358   end;\r
20359 end;\r
20360 \r
20361 function TKOLActionList.GetCount: integer;\r
20362 begin\r
20363   Result:=FActions.Count;\r
20364 end;\r
20365 \r
20366 function TKOLActionList.GetKOLAction(Index: Integer): TKOLAction;\r
20367 begin\r
20368   Result:=FActions[Index];\r
20369 end;\r
20370 \r
20371 procedure TKOLActionList.SetChildOrder(Component: TComponent;\r
20372   Order: Integer);\r
20373 begin\r
20374   if FActions.IndexOf(Component) >= 0 then\r
20375     (Component as TKOLAction).Index := Order;\r
20376 end;\r
20377 \r
20378 procedure TKOLActionList.SetKOLAction(Index: Integer; const Value: TKOLAction);\r
20379 begin\r
20380   TKOLAction(FActions[Index]).Assign(Value);\r
20381 end;\r
20382 \r
20383 procedure TKOLActionList.SetOnUpdateActions(const Value: TOnEvent);\r
20384 begin\r
20385   if @FOnUpdateActions = @Value then exit;\r
20386   FOnUpdateActions:=Value;\r
20387   Change;\r
20388 end;\r
20389 \r
20390 procedure TKOLActionList.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String);\r
20391 begin\r
20392   SL.Add( Prefix + AName + ' := NewActionList( ' + AParent + ' );' );\r
20393   GenerateTag( SL, AName, Prefix );\r
20394 end;\r
20395 \r
20396 procedure TKOLActionList.SetupLast(SL: TStringList; const AName, AParent, Prefix: String);\r
20397 var\r
20398   i, j: integer;\r
20399   s, ss, n, p, pf: string;\r
20400   c: TComponent;\r
20401 begin\r
20402   SL.Add('');\r
20403   n:=Prefix + AName;\r
20404   p:=AName;\r
20405   i:=Pos('.', AName);\r
20406   if i <> 0 then\r
20407     pf:=Copy(AName, 1, i - 1)\r
20408   else\r
20409     pf:=AName;\r
20410   p:=Prefix + pf;\r
20411 \r
20412   for i:=0 to FActions.Count - 1 do\r
20413     with Actions[i] do begin\r
20414       ResolveLinks;\r
20415       if @FOnExecute <> nil then\r
20416         s:=pf + '.' + ParentForm.MethodName(@FOnExecute)\r
20417       else\r
20418         s:='nil';\r
20419 \r
20420       ss:=Caption;\r
20421       //---------------------------------------- remove by YS 7 Aug 2004 -|\r
20422       //if Accelerator.Key <> vkNotPresent then                           |\r
20423       //  ss:=ss + #9 + Accelerator.AsText;                               |\r
20424       //------------------------------------------------------------------|\r
20425       SL.Add(Format('%s.%s := %s.Add( %s, %s, %s );',\r
20426                     [p, Name, AName, StringConstant('Caption', ss),\r
20427                      StringConstant('Hint', Hint), s]));\r
20428 \r
20429       for j:=0 to FLinked.Count - 1 do begin\r
20430         c:=TComponent(FLinked.Objects[j]);\r
20431         if c = nil then\r
20432           SL.Add(Format('%s// WARNING: Linked component %s can not be found. Possibly it is located at form that not currently loaded.', [Prefix, FLinked[j]]))\r
20433         else\r
20434           if c is TKOLMenuItem then begin\r
20435             with TKOLMenuItem(c) do\r
20436               SL.Add(Format('%s.%s.LinkMenuItem( %s.%s, %d );', [p, Actions[i].Name, pf, MenuComponent.Name, itemindex]))\r
20437           end\r
20438           else\r
20439           if c is TKOLCustomControl then\r
20440             with TKOLCustomControl(c) do\r
20441               SL.Add(Format('%s.%s.LinkControl( %s.%s );', [p, Actions[i].Name, pf, Name]))\r
20442           else\r
20443           if c is TKOLToolbarButton then\r
20444             with TKOLToolbarButton(c) do\r
20445               SL.Add(Format('%s.%s.LinkToolbarButton( %s.%s, %d );', [p, Actions[i].Name, pf, ToolbarComponent.Name, ToolbarComponent.Items.IndexOf(c)]))\r
20446       end;\r
20447 \r
20448       if Checked then\r
20449         SL.Add(Format('%s.%s.Checked := True;', [p, Name]));\r
20450       if not Visible then\r
20451         SL.Add(Format('%s.%s.Visible := False;', [p, Name]));\r
20452       if not Enabled then\r
20453         SL.Add(Format('%s.%s.Enabled := False;', [p, Name]));\r
20454       if HelpContext <> 0 then\r
20455         SL.Add(Format('%s.%s.HelpContext := %d;', [p, Name, HelpContext]));\r
20456       if Tag <> 0 then\r
20457         SL.Add(Format('%s.%s.Tag := %d;', [p, Name, Tag]));\r
20458 \r
20459       if Accelerator.Key <> vkNotPresent then begin\r
20460         S := 'FVIRTKEY';\r
20461         if kapShift in Accelerator.Prefix then\r
20462           S := S + ' or FSHIFT';\r
20463         if kapControl in Accelerator.Prefix then\r
20464           S := S + ' or FCONTROL';\r
20465         if kapAlt in Accelerator.Prefix then\r
20466           S := S + ' or FALT';\r
20467         if kapNoinvert in Accelerator.Prefix then\r
20468           S := S + ' or FNOINVERT';\r
20469         SL.Add(Format('%s.%s.Accelerator := MakeAccelerator(%s, %s);', [p, Name, S, VirtKeys[ Accelerator.Key ]]));\r
20470       end;\r
20471 \r
20472 \r
20473       SL.Add('');\r
20474     end;\r
20475 end;\r
20476 \r
20477 { TKOLActionListEditor }\r
20478 \r
20479 procedure TKOLActionListEditor.Edit;\r
20480 var AL: TKOLActionList;\r
20481 begin\r
20482   if Component = nil then Exit;\r
20483   if not(Component is TKOLActionList) then Exit;\r
20484   AL := Component as TKOLActionList;\r
20485   if AL.ActiveDesign = nil then\r
20486     AL.ActiveDesign := TfmActionListEditor.Create( Application );\r
20487   AL.ActiveDesign.ActionList := AL;\r
20488   AL.ActiveDesign.Visible := True;\r
20489   SetForegroundWindow( AL.ActiveDesign.Handle );\r
20490   AL.ActiveDesign.MakeActive( TRUE );\r
20491 {\r
20492   if AL.ParentForm <> nil then\r
20493     AL.ParentForm.Invalidate;\r
20494 }\r
20495 end;\r
20496 \r
20497 procedure TKOLActionListEditor.ExecuteVerb(Index: Integer);\r
20498 begin\r
20499   Edit;\r
20500 end;\r
20501 \r
20502 function TKOLActionListEditor.GetVerb(Index: Integer): string;\r
20503 begin\r
20504   Result := '&Edit actions';\r
20505 end;\r
20506 \r
20507 function TKOLActionListEditor.GetVerbCount: Integer;\r
20508 begin\r
20509   Result := 1;\r
20510 end;\r
20511 \r
20512 { TKOLControl }\r
20513 \r
20514 procedure TKOLControl.Change;\r
20515 begin\r
20516   //Log( '->TKOLControl.Change' );\r
20517   TRY\r
20518     inherited;\r
20519   //LogOK;\r
20520   FINALLY\r
20521     //Log( '<-TKOLControl.Change' );\r
20522   END;\r
20523 end;\r
20524 \r
20525 function TKOLControl.Generate_SetSize: String;\r
20526 begin\r
20527   Result := inherited Generate_SetSize;\r
20528 end;\r
20529 \r
20530 \r
20531 initialization\r
20532 \r
20533 finalization\r
20534   Log( '->F i n a l i z a t i o n' );\r
20535   FormsList.Free;\r
20536   FormsList := nil;\r
20537   LogOK;\r
20538   Log( '<-F i n a l i z a t i o n' );\r
20539 \r
20540 end.\r