home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d2345 / JSFORMEX.ZIP / src / FormEx.pas < prev   
Pascal/Delphi Source File  |  2001-05-19  |  65KB  |  2,195 lines
  1. ////////////////////////////////////////////////////////////////////////////////
  2. // Jazarsoft FormEx                                                           //
  3. ////////////////////////////////////////////////////////////////////////////////
  4. //                                                                            //
  5. // VERSION      : 2.1                                                         //
  6. // AUTHOR       : James Azarja                                                //
  7. // CREATED      : 30 July 2000                                                //
  8. // MODIFIED     : 16 March 2001                                               //
  9. // WEBSITE      : http://www.jazarsoft.com                                    //
  10. // SUPPORT      : support@jazarsoft.com                                       //
  11. // BUG-REPORT   : bugreport@jazarsoft.com                                     //
  12. // COMMENT      : comment@jazarsoft.com                                       //
  13. // LEGAL        : Copyright (C) 2000-2001 Jazarsoft.                          //
  14. //                                                                            //
  15. ////////////////////////////////////////////////////////////////////////////////
  16. //                                                                            //
  17. // This code may be used and modified by anyone so long as  this header and   //
  18. // copyright  information remains intact.                                     //
  19. //                                                                            //
  20. // The code is provided "as-is" and without warranty of any kind,             //
  21. // expressed, implied or otherwise, including and without limitation, any     //
  22. // warranty of merchantability or fitness for a  particular purpose.á         //
  23. //                                                                            //
  24. // In no event shall the author be liable for any special, incidental,        //
  25. // indirect or consequential damages whatsoever (including, without           //
  26. // limitation, damages for loss of profits, business interruption, loss       //
  27. // of information, or any other loss), whether or not advised of the          //
  28. // possibility of damage, and on any theory of liability, arising out of      //
  29. // or in connection with the use or inability to use this software.áá         //
  30. //                                                                            //
  31. ////////////////////////////////////////////////////////////////////////////////
  32. // HISTORY                                                                    //
  33. //                                                                            //
  34. // 1.0 - Initial Public Release                                               //
  35. // 1.1 - Fixed "Minimize" bug.                                                //
  36. //       Fixed "Scrolling Caption" bug.                                       //
  37. //       Added SendKeys Feature                                               //
  38. // 2.0 - Major code reconstruction                          //
  39. //       - Unnecessary code                                                   //
  40. //       - Transparent Form                                                   //
  41. //       + Gradient Background                                                //
  42. //       + FormShaper Feature                                                 //
  43. //       + Animated Cursor Feature                                            //
  44. //       + Animated Icon Feature                                              //
  45. //       + Capture Window Feature                                             //
  46. // 2.1 - + Added BeginSizeMove and EndSizeMove Event                          //
  47. //         Thanks to Morris Howorth (morris.howorth@zen.co.uk)                //
  48. //         Fixed "null icons bugs" for the animated icon                     //
  49. //                                                                            //
  50. //                                                                            //
  51. ////////////////////////////////////////////////////////////////////////////////
  52. // NOTE                                                                       //
  53. //                                                                            //
  54. //  FormEx 2.0 Completely NOT COMPATIBLE WITH earlier version                 //
  55. //                                                                            //
  56. ////////////////////////////////////////////////////////////////////////////////
  57.  
  58. unit FormEx;
  59.  
  60. {$HINTS OFF}
  61. {$WARNINGS OFF}
  62. {$IFDEF VER130}
  63.  {$DEFINE D4PLUS}
  64. {$ENDIF}
  65. {$IFDEF VER120}
  66.  {$DEFINE D4PLUS}
  67. {$ENDIF}
  68.  
  69. interface
  70.  
  71. uses
  72.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  73.   ShellApi, Registry, ExtCtrls, ImgList, Menus, DsgnIntf;
  74.   
  75. Const
  76.   { FormEx Cursor Handle }
  77.   crFormExCursor = 999;
  78.   SysMenuExID    = $FFF;
  79.  
  80.   {$IFNDEF D4PLUS}
  81.   SPI_GETFOREGROUNDLOCKTIMEOUT = $2000;
  82.   SPI_SETFOREGROUNDLOCKTIMEOUT = $2001;
  83.   {$ENDIF}
  84.  
  85.   WM_ICONTRAYNOTIFY    = WM_USER + 1234;
  86.   IconID               = 12345;
  87.  
  88.  
  89. type
  90.   { Events }
  91.   TOnNonClientClick  = procedure (Sender: TObject;Var Position : TPoint) of object;
  92.   TOnDropFiles       = Procedure (Sender: TObject;Var Files: TStrings;Var Position : TPoint) of object;
  93.   TOnIconCycle       = procedure(Sender: TObject; Current: Integer) of object;
  94.  
  95.   TScrollDirection   = (dLeft,
  96.                         dRight);
  97.  
  98.   TDrawMethod        = (dmNormal,
  99.                         dmCenter,
  100.                         dmTile,
  101.                         dmStretch);
  102.  
  103.   TFormMoveableStyle = (fmsDefault,
  104.                         fmsNever,
  105.                         fmsAlways);
  106.  
  107.   TFormTopMostStyle  = (ftmsDefault,
  108.                         ftmsWhenAcceptFiles,
  109.                         ftmsAlways);
  110.  
  111.   TFormTaskStyle     = (ftsDefault,
  112.                         ftsWhenVisible,
  113.                         ftsAlways);
  114.  
  115.   TFormCoverStyle    = (fcsNone,
  116.                         fcsImage,
  117.                         fcsGradient);
  118.                         
  119.  
  120.   TFormExThread = class(TThread)
  121.   private
  122.   protected
  123.     procedure   Execute; override;
  124.   public
  125.     constructor Create;
  126.     destructor  Destroy; override;
  127.     procedure   Release;
  128.   end;
  129.  
  130.   TTrayIcon = class(TPersistent)
  131.   private
  132.     ParentForm     : tForm;
  133.     ParentFormEx   : TComponent;
  134.     Timer          : TTimer;
  135.  
  136.     FEnabled       : Boolean;
  137.     FIcon          : TIcon;
  138.     FIconVisible   : Boolean;
  139.     FHint          : String;
  140.     FShowHint      : Boolean;
  141.     FLeftPopupMenu : TPopupMenu;
  142.     FRightPopupMenu: TPopupMenu;
  143.  
  144.     FIconList      : TImageList;
  145.     FCycleIcons    : Boolean;
  146.     FCycleInterval : Cardinal;
  147.     IconIndex      : Integer;
  148.     procedure SetCycleIcons(Value: Boolean);
  149.     procedure SetCycleInterval(Value: Cardinal);
  150.     procedure HandleIconMessage(var Msg: TMessage);
  151.     function  InitIcon: Boolean;
  152.     procedure SetIcon(Value: TIcon);
  153.     procedure SetIconVisible(Value: Boolean);
  154.     procedure SetHint(Value: String);
  155.     procedure SetShowHint(Value: Boolean);
  156.     procedure PopupAtCursor(Index:Integer);
  157.   protected
  158.     IconData                  : TNotifyIconData;
  159.     procedure Click; dynamic;
  160.     procedure DblClick; dynamic;
  161.     procedure CycleIcon; dynamic;
  162.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  163.       X, Y: Integer); dynamic;
  164.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  165.       X, Y: Integer); dynamic;
  166.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
  167.  
  168.     function ShowIcon: Boolean; virtual;
  169.     function HideIcon: Boolean; virtual;
  170.     function ModifyIcon: Boolean; virtual;
  171.  
  172.     Procedure OnTimer(Sender:TObject);
  173.   public
  174.     constructor Create(Parent:tForm;ParentClass:tComponent);
  175.     destructor  Destroy; override;
  176.     Procedure   NextIconCycle;
  177.   published
  178.     property IconList             : TImageList  read FIconList        write FIconList;
  179.     property CycleIcons           : Boolean     read FCycleIcons      write SetCycleIcons;
  180.     property CycleInterval        : Cardinal    read FCycleInterval   write SetCycleInterval;
  181.     property Enabled              : Boolean     read FEnabled         write FEnabled;
  182.     property Hint                 : String      read FHint            write SetHint;
  183.     property ShowHint             : Boolean     read FShowHint        write SetShowHint;
  184.     property Icon                 : TIcon       read FIcon            write SetIcon stored True;
  185.     property IconVisible          : Boolean     read FIconVisible     write SetIconVisible;
  186.     property LeftPopupMenu        : TPopupMenu  read FLeftPopupMenu   write FLeftPopupMenu;
  187.     property RightPopUpMenu       : tPopUpMenu  read FRightPopUpMenu  write FRightPopUpMenu;
  188.   end;
  189.  
  190.   TRatio = class (TPersistent)
  191.   private
  192.     FEnabled              : Boolean;
  193.     FWidth                : Integer;
  194.     FHeight               : Integer;
  195.     FAspectRatio          : Single;
  196.   protected
  197.     procedure SetWidth(value:integer);
  198.     procedure SetHeight(value:integer);
  199.     procedure SetAspectRatio(value:single);
  200.   public
  201.   published
  202.     property Enabled       : Boolean Read FEnabled     Write FEnabled;
  203.     property Width         : Integer Read FWidth       Write SetWidth;
  204.     property Height        : Integer Read FHeight      Write SetHeight;
  205.     property AspectRatio   : Single  Read FAspectRatio Write SetAspectRatio;
  206.   end;
  207.  
  208.   TResize = class (TPersistent)
  209.   private
  210.     FEnabled      : Boolean;
  211.     FRatio        : TRatio;
  212.     FBorderWidth  : Integer;
  213.     FMaxWidth     : Integer;
  214.     FMinWidth     : Integer;
  215.     FMaxHeight    : Integer;
  216.     FMinHeight    : Integer;
  217.     procedure SetRatio(Value:TRatio);
  218.   public
  219.     constructor Create;
  220.     destructor Destroy;override;
  221.   published
  222.     property Enabled     : Boolean   Read FEnabled     Write FEnabled;
  223.     property Ratio       : TRatio    Read FRatio       Write SetRatio;
  224.     property BorderWidth : Integer   Read FBorderWidth Write FBorderWidth;
  225.     property MaxWidth    : Integer   Read FMaxWidth    Write FMaxWidth;
  226.     property MaxHeight   : Integer   Read FmaxHeight   Write FMaxHeight;
  227.     property MinWidth    : Integer   Read FMinWidth    Write FMinWidth;
  228.     property MinHeight   : Integer   Read FMinHeight   Write FMinHeight;
  229.   end;
  230.  
  231.   TMargin = class (TPersistent)
  232.   private
  233.     FLeftMin   : Integer;
  234.     FLeftMax   : Integer;
  235.     FTopMin    : Integer;
  236.     FTopMax    : Integer;
  237.     FRightMin  : Integer;
  238.     FRightMax  : Integer;
  239.     FBottomMin : Integer;
  240.     FBottomMax : Integer;
  241.     FEnabled   : Boolean;
  242.   public
  243.     constructor Create;
  244.   published
  245.     property Enabled   : Boolean Read FEnabled   Write FEnabled;
  246.     property LeftMin   : Integer Read FLeftMin   Write FLeftMin;
  247.     property LeftMax   : Integer Read FLeftMax   Write FLeftMax;
  248.     property RightMin  : Integer Read FRightMin  Write FRightMin;
  249.     property RightMax  : Integer Read FRightMax  Write FRightMax;
  250.     property TopMin    : Integer Read FTopMin    Write FTopMin;
  251.     property TopMax    : Integer Read FTopMax    Write FTopMax;
  252.     property BottomMin : Integer Read FBottomMin Write FBottomMin;
  253.     property BottomMax : Integer Read FBottomMax Write FBottomMax;
  254.   end;
  255.  
  256.   TPlacement = class (TPersistent)
  257.   private
  258.     ParentForm                : tForm;
  259.     FMargin                   : TMargin;
  260.     FAlwaysOnScreen           : Boolean;
  261.     FTopMost                  : tFormTopMostStyle;
  262.  
  263.     FMoveable                 : tFormMoveableStyle;
  264.     Procedure SetTopMost(Value:tFormTopMostStyle);
  265.   protected
  266.     procedure TopMostAction;
  267.   public
  268.     constructor Create(Parent:TForm);
  269.     destructor Destroy;override;
  270.   published
  271.     property    Margin            : TMargin            Read FMargin           Write FMargin;
  272.     property    TopMost           : tFormTopMostStyle  Read FTopMost          Write SetTopMost;
  273.     property    AlwaysOnScreen    : Boolean            Read FAlwaysOnScreen   Write FAlwaysOnScreen;
  274.     property    Moveable          : tFormMoveableStyle Read FMoveable         Write FMoveable;
  275.   end;
  276.  
  277.   TFormSaver = Class(TPersistent)
  278.   private
  279.     FGlobal      : Boolean;
  280.     FKeyName     : String;
  281.     FEnabled     : Boolean;
  282.  
  283.     FPosition    : Boolean;
  284.     FSize        : Boolean;
  285.   protected
  286.   public
  287.   published
  288.     property Global   : Boolean Read FGlobal  Write FGlobal;
  289.     property KeyName  : String  Read FKeyname Write FKeyName;
  290.     property Enabled  : Boolean Read FEnabled Write FEnabled;
  291.  
  292.     property Position : Boolean Read FPosition Write FPosition;
  293.     property Size     : Boolean Read FSize     Write FSize; 
  294.   end;
  295.  
  296.   TCoverGradient = Class(TPersistent)
  297.   private
  298.     FSource ,
  299.     FDestination   : tColor;
  300.   protected
  301.   public
  302.     constructor Create;
  303.     destructor Destroy;override;
  304.   published
  305.     property Source       : tColor        Read FSource         Write FSource;
  306.     property Destination  : tColor      Read FDestination     Write FDestination;
  307.   end;
  308.  
  309.   TCoverImage = Class(TPersistent)
  310.   private
  311.     FDrawMethod             : tDrawMethod;
  312.     FClient                 : tBitmap;
  313.     procedure SetClient(Value:tBitmap);
  314.     Procedure SetDrawMethod(Value:tDrawMethod);
  315.   protected
  316.   public
  317.     constructor Create;
  318.     destructor Destroy;override;
  319.   published
  320.     property Image            : tBitmap     Read FClient     Write SetClient;
  321.     property DrawMethod       : tDrawMethod Read FDrawMethod Write SetDrawMethod;
  322.   end;
  323.   
  324.   TCover = Class(TPersistent)
  325.   private
  326.     FStyle            : tFormCoverStyle;
  327.     FCoverImage       : tCoverImage;
  328.     FCoverGradient    : tCoverGradient;
  329.   protected
  330.   public
  331.     constructor Create;
  332.     destructor Destroy;override;
  333.   published
  334.     property Style     : tFormCoverStyle     Read FStyle         Write FStyle;
  335.     property Image     : tCoverImage         Read FCoverImage    Write FCoverImage;
  336.     property Gradient  : tCoverGradient      Read FCoverGradient Write FCoverGradient;
  337.   end;
  338.  
  339.   TCaptionScroll = class(TPersistent)
  340.   private
  341.     ParentForm     : TForm;
  342.     ParentHwnd     : Hwnd;
  343.  
  344.     OldAppCaption  ,
  345.     OldFormCaption ,
  346.     FCaption       ,
  347.     FSpace         : String;
  348.     TmpCount       : Integer;
  349.     FIsMainWindow  : Boolean;
  350.     FDirection     : TScrollDirection;
  351.     FEnabled       : Boolean;
  352.     FInterval      : Word;
  353.     FWindowHandle  : Hwnd;
  354.     Timer          : TTimer;
  355.     procedure SetCaption(Value: String);
  356.     procedure SetEnabled(Value: Boolean);
  357.     procedure SetInterval(Value: Word);
  358.   protected
  359.     procedure ProcessCaption; dynamic;
  360.     Procedure OnTimer(Sender: TObject);
  361.   public
  362.     constructor Create(Parent:TForm);
  363.     destructor Destroy; override;
  364.   published
  365.     property Caption      : String           read FCaption      write SetCaption;
  366.     property Direction    : TScrollDirection read FDirection    write FDirection;
  367.     property IsMainWindow : Boolean          read FIsMainWindow write FIsMainWindow;
  368.     property Space        : String           read FSpace        write FSpace;
  369.     property Enabled      : Boolean          read FEnabled      write SetEnabled;
  370.     property Interval     : Word             read FInterval     write SetInterval;
  371.   end;
  372.  
  373.   TAnimatedIcon = class (TPersistent)
  374.   private
  375.     FEnabled      : Boolean;
  376.     FIcons        : TImageList; 
  377.     FDelay        : Integer;
  378.  
  379.     Timer         : TTimer;
  380.     FIndex        : Integer;
  381.     Ic            : TIcon;
  382.     ParentForm    : tForm;    
  383.     Procedure SetEnabled(Value:Boolean);
  384.   protected
  385.     Procedure  OnTimer(Sender: TObject);
  386.   public
  387.     Constructor Create(Parent:tForm);
  388.     destructor Destroy;override;
  389.     property Index       : Integer           Read FIndex;
  390.   published
  391.     property Enabled     : Boolean           Read FEnabled     Write SetEnabled;
  392.     property Icons       : TImageList        Read FIcons       Write FIcons; 
  393.     property Delay       : Integer           Read FDelay       Write FDelay;     
  394.   end;
  395.  
  396.   TAppearance = Class(TPersistent)
  397.   private
  398.     ParentForm                   : tForm;
  399.     ParentHwnd                   : Hwnd;
  400.  
  401.     Old                          ,
  402.     Oldh                         ,
  403.     Oldw                         ,
  404.     Oldx                         ,
  405.     Oldy                         : Integer;
  406.     Olds                         : TWindowState;
  407.     OldStyleEx                   : Integer;
  408.  
  409.     FCover                       : TCover;
  410.     FShowTitleBar                : Boolean;
  411.     FShowOnTaskBar               : tFormTaskStyle;
  412.     FAcceptFiles                 : Boolean;
  413.     FShapePoints                 : tStrings;
  414.     FCursor                      : tFilename;
  415.     FFullScreen                  : Boolean;
  416.     FCaptionScroll               : tCaptionScroll;
  417.     FAlwaysMinimize              : Boolean;
  418.     FAnimatedIcon                : tAnimatedIcon;
  419.  
  420.     Procedure SetAlwaysMinimize(Value:Boolean);
  421.     Procedure SetFullScreen(Value:Boolean);
  422.     Procedure SetShowTitleBar(Value:Boolean);
  423.     Procedure SetCover(Value:tCover);
  424.     Procedure SetShowOnTaskbar(Value:tFormTaskStyle);
  425.     procedure SetAcceptFiles(Value: Boolean);
  426.     Procedure SetShapePoints(Value : tStrings);
  427.     Procedure SetCursor(Value : tFilename);
  428.   protected
  429.     Procedure TitleBarAction;
  430.     procedure TaskAction;
  431.     Procedure ApplyShape;
  432.     Procedure RemoveShape;
  433.   public
  434.     constructor Create(Parent:TForm);
  435.     destructor Destroy;override;
  436.   published
  437.     property AnimatedIcon         : tAnimatedIcon     Read FAnimatedIcon     Write FAnimatedIcon;  
  438.     property Cover                : TCover            Read FCover            Write SetCover;
  439.     property ShowTitleBar         : Boolean           Read FShowTitleBar     Write SetShowTitleBar;
  440.     property ShowOnTaskBar        : tFormTaskStyle    Read FShowOnTaskBar    Write SetShowOnTaskBar;
  441.     property AcceptFiles          : Boolean           Read FAcceptFiles      Write SetAcceptFiles;
  442.     property Shape                : tStrings          Read FShapePoints      Write SetShapePoints;   
  443.     property Cursor               : TFilename         Read FCursor           Write SetCursor;   
  444.     property FullScreen           : Boolean           Read FFullScreen       Write SetFullScreen;     
  445.     property CaptionScroll        : tCaptionScroll    Read FCaptionScroll    Write FCaptionScroll;
  446.     property AlwaysMinimize       : Boolean           Read FAlwaysMinimize   Write SetAlwaysMinimize;
  447.   end;
  448.  
  449.   TFormEx = class(TComponent)
  450.   private
  451.     PrevParentWndProc         : Pointer;
  452.     SeekAndDestroy            : Boolean;
  453.     ParentHwnd                : HWND;
  454.     ParentForm                : tForm;
  455.     FormExThread              : tFormExThread;
  456.     
  457.     BGBuffer                  : tBitmap;
  458.  
  459.     { Sub Properties }
  460.     FPlacement                : TPlacement;
  461.     FResize                   : TResize;
  462.     FFormSaver                : TFormSaver;
  463.     FAppearance               : TAppearance;
  464.     FTrayIcon                 : tTrayIcon;
  465.     
  466.     { Events }
  467.     FOnNonClientClick         : tOnNonClientClick;
  468.     FOnDropFiles              : tOnDropFiles;
  469.     FOnMinimize               : tNotifyEvent;
  470.     FOnMaximize               : tNotifyEvent;
  471.     FOnRestore                : tNotifyEvent;
  472.     FOnEndSizeMove            : tNotifyEvent;
  473.     FOnBeginSizeMove          : tNotifyEvent;
  474.     FOnFontChange             : tNotifyEvent;
  475.  
  476.     FOnTrayIconClick          ,
  477.     FOnTrayIconDblClick       : TNotifyEvent;
  478.     FOnTrayIconCycle          : TOnIconCycle;
  479.     FOnTrayIconMouseDown      ,
  480.     FOnTrayIconMouseUp        : TMouseEvent;
  481.     FOnTrayIconMouseMove      : TMouseMoveEvent;
  482.  
  483.     { Variable }
  484.     FSysMenuEx                : tPopUpMenu;
  485.  
  486.     IgnoreNextMessage         : Boolean;
  487.  
  488.     Procedure SetSysMenuEx(Value:tPopupMenu);
  489.   protected
  490.     procedure NewParentWndProc(var Message:Tmessage);
  491.  
  492.     procedure RebuildBG;
  493.     procedure BuildBGImage;
  494.     procedure BuildBGGradient;
  495.  
  496.     procedure DrawBG;
  497.  
  498.     procedure SaveSettings;
  499.     procedure LoadSettings;
  500.   public
  501.     constructor create(AOwner:TComponent);override;
  502.     destructor  destroy;override;
  503.     procedure   Loaded;override;
  504.    
  505.     Procedure   SendKeys(WinHandle:Hwnd;Buffer:String);
  506.     Procedure   CaptureWindow(WinHandle:Hwnd;Filename:String);
  507.     Procedure   Flash(Number,Delay:Integer);
  508.     Procedure   CenterOnForm(Form:tForm);
  509.     Procedure   HorizontalCenter(Form:tForm);
  510.     Procedure   VerticalCenter(Form:tForm);
  511.     procedure   SizeForWindowsDesktop; { Outside taskbar area }
  512.   published
  513.     property    Appearance        : TAppearance        Read FAppearance       Write FAppearance;
  514.     property    Placement         : TPlacement         Read FPlacement        Write FPlacement;
  515.     property    Resize            : TResize            Read FResize           Write FResize;
  516.     property    FormSaver         : TFormSaver         Read FFormSaver        Write FFormSaver;
  517.     property    TrayIcon          : tTrayIcon          Read FTrayIcon         Write FTrayIcon;
  518.  
  519.     property    SysMenuEx         : tPopUpMenu         Read FSysMenuEx        Write SetSysMenuEx;
  520.  
  521.     property    OnNonClientClick  : tOnNonClientClick  Read FOnNonClientClick Write FOnNonClientClick;
  522.     property    OnDropFiles       : tOnDropFiles       Read FOnDropFiles      Write FOnDropFiles;
  523.     property    OnMinimize        : tNotifyEvent       Read FOnMinimize       Write FOnMinimize;
  524.     property    OnMaximize        : tNotifyEvent       Read FOnMaximize       Write FOnMaximize;
  525.     property    OnRestore         : tNotifyEvent       Read FOnRestore        Write FOnRestore;
  526.     property    OnBeginSizeMove   : tNotifyEvent       Read FOnBeginSizeMove  Write FOnBeginSizeMove;
  527.     property    OnEndSizeMove     : tNotifyEvent       Read FOnEndSizeMove    Write FOnEndSizeMove;
  528.     property    OnFontChange      : tNotifyEvent       Read FOnFontChange     Write FOnFontChange;
  529.     
  530.     property OnTrayIconClick      : TNotifyEvent       read FOnTrayIconClick      write FOnTrayIconClick;
  531.     property OnTrayIconDblClick   : TNotifyEvent       read FOnTrayIconDblClick   write FOnTrayIconDblClick;
  532.     property OnTrayIconMouseDown  : TMouseEvent        read FOnTrayIconMouseDown  write FOnTrayIconMouseDown;
  533.     property OnTrayIconMouseUp    : TMouseEvent        read FOnTrayIconMouseUp    write FOnTrayIconMouseUp;
  534.     property OnTrayIconMouseMove  : TMouseMoveEvent    read FOnTrayIconMouseMove  write FOnTrayIconMouseMove;
  535.     property OnTrayIconCycle      : TOnIconCycle       read FOnTrayIconCycle      write FOnTrayIconCycle;
  536.   end;
  537.  
  538. procedure Register;
  539.  
  540. implementation
  541. Var
  542.   Designing                 : Boolean;
  543.  
  544. constructor TFormExThread.Create;
  545. begin
  546.   FreeOnTerminate := TRUE;
  547.   inherited Create(TRUE);
  548. end;
  549.  
  550. destructor TFormExThread.Destroy;
  551. Begin
  552.   inherited Destroy;
  553. end;
  554.  
  555. procedure TFormExThread.Release;
  556. Begin
  557. end;
  558.  
  559. procedure TFormExThread.Execute;
  560. begin
  561.   ReturnValue := 0;
  562. end;
  563.  
  564. constructor TTrayIcon.Create(Parent:tForm;ParentClass:tComponent);
  565. begin
  566.   inherited Create;
  567.  
  568.   FIconVisible              := False;
  569.   FCycleInterval            := 200;
  570.   FEnabled                  := False;
  571.   ParentForm                := Parent;
  572.   ParentFormEx              := ParentClass;
  573.  
  574.   FIcon                     := TIcon.Create;
  575.   
  576.   IconData.cbSize           := SizeOf(TNotifyIconData);
  577.   IconData.wnd              := AllocateHWnd(HandleIconMessage);
  578.   IconData.uId              := IconID;
  579.   IconData.uFlags           := NIF_ICON + NIF_MESSAGE + NIF_TIP;
  580.   IconData.uCallbackMessage := WM_ICONTRAYNOTIFY;
  581. end;
  582.  
  583. destructor TTrayIcon.Destroy;
  584. begin
  585.   SetIconVisible(False);
  586.   FIcon.Free;
  587.   DeallocateHWnd(IconData.Wnd);  
  588.   inherited Destroy;
  589. end;
  590.  
  591. procedure TTrayIcon.Click;
  592. begin
  593.   if Assigned(TFormEx(ParentFormEx).FOnTrayIconClick) then
  594.     TFormEx(ParentFormEx).FOnTrayIconClick(Self);
  595. end;
  596.  
  597. procedure TTrayIcon.DblClick;
  598. begin
  599.   if Assigned(TFormEx(ParentFormEx).FOnTrayIconDblClick) then
  600.     TFormEx(ParentFormEx).FOnTrayIconDblClick(Self);
  601. end;
  602.  
  603.  
  604. procedure TTrayIcon.MouseDown(Button: TMouseButton; Shift: TShiftState;
  605.   X, Y: Integer);
  606. begin
  607.   if Assigned(TFormEx(ParentFormEx).FOnTrayIconMouseDown) then
  608.     TFormEx(ParentFormEx).FOnTrayIconMouseDown(Self, Button, Shift, X, Y);
  609. end;
  610.  
  611. procedure TTrayIcon.MouseUp(Button: TMouseButton; Shift: TShiftState;
  612.   X, Y: Integer);
  613. begin
  614.   if Assigned(TFormEx(ParentFormEx).FOnTrayIconMouseUp) then
  615.     TFormEx(ParentFormEx).FOnTrayIconMouseUp(Self, Button, Shift, X, Y);
  616. end;
  617.  
  618.  
  619. procedure TTrayIcon.MouseMove(Shift: TShiftState; X, Y: Integer);
  620. begin
  621.   if Assigned(TFormEx(ParentFormEx).FOnTrayIconMouseMove) then
  622.     TFormEx(ParentFormEx).FOnTrayIconMouseMove(Self, Shift, X, Y);
  623. end;
  624.  
  625. procedure TTrayIcon.CycleIcon;
  626. begin
  627.   if Assigned(TFormEx(ParentFormEx).FOnTrayIconCycle) then
  628.     TFormEx(ParentFormEx).FOnTrayIconCycle(Self, IconIndex);
  629. end;
  630.  
  631. procedure TTrayIcon.NextIconCycle;
  632. begin
  633.   if Assigned(FIconList) then
  634.   begin
  635.     CycleIcon;
  636.     FIconList.GetIcon(IconIndex, FIcon);
  637.     ModifyIcon;
  638.  
  639.     if IconIndex < FIconList.Count-1 then  Inc(IconIndex)
  640.     else  IconIndex := 0;
  641.   end;
  642. end;
  643.  
  644. procedure TTrayIcon.HandleIconMessage(var Msg: TMessage);
  645.  
  646. function ShiftState: TShiftState;
  647. begin
  648.  Result := [];
  649.  if GetKeyState(VK_SHIFT) < 0 then Include(Result, ssShift);
  650.  if GetKeyState(VK_CONTROL) < 0 then Include(Result, ssCtrl);
  651.  if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt);
  652. end;
  653.  
  654. var
  655.   Pt: TPoint;
  656.   Shift: TShiftState;
  657.   I: Integer;
  658.   M: TMenuItem;
  659. begin
  660.   if Msg.Msg = WM_ICONTRAYNOTIFY then
  661.   begin
  662.     case Msg.lParam of
  663.  
  664.     WM_MOUSEMOVE:
  665.       if FEnabled then
  666.       begin
  667.         Shift := ShiftState;
  668.         GetCursorPos(Pt);
  669.         MouseMove(Shift, Pt.X, Pt.Y);
  670.       end;
  671.  
  672.     WM_LBUTTONDOWN:
  673.       if FEnabled then
  674.       begin
  675.         Shift := ShiftState + [ssLeft];
  676.         GetCursorPos(Pt);
  677.         MouseDown(mbLeft, Shift, Pt.X, Pt.Y);
  678.         PopUpAtCursor(0);
  679.       end;
  680.  
  681.     WM_RBUTTONDOWN:
  682.       if FEnabled then
  683.       begin
  684.         Shift := ShiftState + [ssRight];
  685.         GetCursorPos(Pt);
  686.         MouseDown(mbRight, Shift, Pt.X, Pt.Y);
  687.         PopUpAtCursor(1);
  688.       end;
  689.  
  690.     WM_MBUTTONDOWN:
  691.       if FEnabled then
  692.       begin
  693.         Shift := ShiftState + [ssMiddle];
  694.         MouseDown(mbMiddle, Shift, Pt.X, Pt.Y);
  695.         GetCursorPos(Pt);
  696.       end;
  697.  
  698.     WM_LBUTTONUP:
  699.       if FEnabled then
  700.       begin
  701.         Shift := ShiftState + [ssLeft];
  702.         GetCursorPos(Pt);
  703.         MouseUp(mbLeft, Shift, Pt.X, Pt.Y);
  704.       end;
  705.  
  706.     WM_RBUTTONUP:
  707.       if FEnabled then
  708.       begin
  709.         Shift := ShiftState + [ssRight];
  710.         GetCursorPos(Pt);
  711.         MouseUp(mbRight, Shift, Pt.X, Pt.Y);
  712.       end;
  713.  
  714.     WM_MBUTTONUP:
  715.       if FEnabled then
  716.       begin
  717.         Shift := ShiftState + [ssMiddle];
  718.         GetCursorPos(Pt);
  719.         MouseUp(mbMiddle, Shift, Pt.X, Pt.Y);
  720.       end;
  721.  
  722.     WM_LBUTTONDBLCLK:
  723.       if FEnabled then
  724.       begin
  725.         DblClick;
  726.         If FLeftPopUpMenu=nil then
  727.         Begin
  728.          M := nil;
  729.          if Assigned(FRightPopupMenu) then
  730.            if (FRightPopupMenu.AutoPopup)  then
  731.              for I := FRightPopUpMenu.Items.Count -1 downto 0 do
  732.              begin
  733.                if FRightPopupMenu.Items[I].Default then
  734.                  M := FRightPopupMenu.Items[I];
  735.              end;
  736.          if M <> nil then
  737.            M.Click;
  738.         End;   
  739.       end;
  740.     end;
  741.   end
  742.  
  743.   else
  744.     case Msg.Msg of
  745.       WM_QUERYENDSESSION: Msg.Result := 1;
  746.     else      
  747.       Msg.Result := DefWindowProc(IconData.Wnd, Msg.Msg, Msg.wParam, Msg.lParam);
  748.     end;
  749. end;
  750.  
  751.  
  752. procedure TTrayIcon.SetIcon(Value: TIcon);
  753. begin
  754.   FIcon.Assign(Value);
  755.   ModifyIcon;
  756. end;
  757.  
  758. procedure TTrayIcon.SetIconVisible(Value: Boolean);
  759. begin
  760.  if Value then ShowIcon else HideIcon;
  761.  FIconVisible:=Value;
  762. end;
  763.  
  764. procedure TTrayIcon.SetCycleIcons(Value: Boolean);
  765. begin
  766.   If (FCycleIcons<>Value) then
  767.   Begin
  768.    FCycleIcons := Value;
  769.    If Value then
  770.    Begin
  771.     IconIndex := 0;
  772.     Timer:=tTimer.Create(nil);
  773.     Timer.Interval:=FCycleInterval;
  774.     Timer.Enabled:=True;
  775.     Timer.OnTimer:=OnTimer;
  776.    End else
  777.      If Assigned(Timer) then Timer.Free;
  778.    End;
  779. end;
  780.  
  781.  
  782. procedure TTrayIcon.SetCycleInterval(Value: Cardinal);
  783. begin
  784.   If Value<>FCycleInterval then
  785.   Begin
  786.    FCycleInterval := Value;
  787.  
  788.    If FCycleIcons then
  789.    Begin
  790.      Timer.Interval:=Value;
  791.    End;
  792.   End;
  793. end;
  794.  
  795. procedure TTrayIcon.SetHint(Value: String);
  796. begin
  797.  If Value<>FHint then
  798.  Begin
  799.   FHint := Value;
  800.   ModifyIcon;
  801.  End;
  802. end;
  803.  
  804. procedure TTrayIcon.SetShowHint(Value: Boolean);
  805. begin
  806.  If Value<>FShowHint then
  807.  begin
  808.   FShowHint := Value;
  809.   ModifyIcon;
  810.  end;
  811. end;
  812.  
  813. Procedure TTrayIcon.OnTimer(Sender:TObject);
  814. Begin
  815.  NextIconCycle;
  816. End;
  817.  
  818. function TTrayIcon.InitIcon: Boolean;
  819. begin
  820.   Result := False;
  821.   if Not Designing then
  822.   begin
  823.     IconData.hIcon := FIcon.Handle;
  824.     if (FHint <> '') and (FShowHint) then
  825.       StrLCopy(IconData.szTip, PChar(FHint), SizeOf(IconData.szTip))
  826.     else
  827.       IconData.szTip := '';
  828.     Result := True;
  829.   end;
  830. end;
  831.  
  832.  
  833. function TTrayIcon.ShowIcon: Boolean;
  834. begin
  835.   Result := False;
  836.   if InitIcon then Result := Shell_NotifyIcon(NIM_ADD, @IconData);
  837. end;
  838.  
  839. function TTrayIcon.HideIcon: Boolean;
  840. begin
  841.  Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
  842. end;
  843.  
  844. function TTrayIcon.ModifyIcon: Boolean;
  845. begin
  846.  Result := False;
  847.  if InitIcon then
  848.    Result := Shell_NotifyIcon(NIM_MODIFY, @IconData);
  849. end;
  850.  
  851. procedure TTrayIcon.PopupAtCursor(Index:Integer);
  852. var
  853.   CursorPos: TPoint;
  854. begin
  855.  Case Index of
  856.  0 : Begin
  857.      if Assigned(LeftPopupMenu) then
  858.       if LeftPopupMenu.AutoPopup then
  859.        if GetCursorPos(CursorPos) then
  860.        begin
  861.          Application.ProcessMessages;
  862.          SetForegroundWindow((ParentForm as TWinControl).Handle);
  863.          if Assigned(Screen.ActiveControl) then
  864.            SetFocus(Screen.ActiveControl.Handle);
  865.          LeftPopupMenu.PopupComponent := ParentForm ;
  866.          LeftPopupMenu.Popup(CursorPos.X, CursorPos.Y);
  867.          PostMessage((ParentForm  as TWinControl).Handle, WM_NULL, 0, 0);
  868.        end;
  869.       End;
  870.  1 : Begin
  871.      if Assigned(RightPopupMenu) then
  872.       if RightPopupMenu.AutoPopup then
  873.        if GetCursorPos(CursorPos) then
  874.        begin
  875.          Application.ProcessMessages;
  876.          SetForegroundWindow((ParentForm as TWinControl).Handle);
  877.          if Assigned(Screen.ActiveControl) then
  878.            SetFocus(Screen.ActiveControl.Handle);
  879.          RightPopupMenu.PopupComponent := ParentForm ;
  880.          RightPopupMenu.Popup(CursorPos.X, CursorPos.Y);
  881.          PostMessage((ParentForm  as TWinControl).Handle, WM_NULL, 0, 0);
  882.        end;
  883.       End;
  884.  End;
  885. end;
  886.  
  887. procedure TRatio.SetWidth(Value:Integer);
  888. begin
  889.   If (Value<>FWidth) then
  890.   Begin
  891.     FWidth := Value;
  892.     If Height=0 then FAspectRatio:=0 else
  893.                      FAspectRatio:=Width/Height;
  894.   End;
  895. end;
  896.  
  897. procedure TRatio.SetHeight(value:integer);
  898. begin
  899.   If (Value<>FHeight) then
  900.   Begin
  901.     FHeight := Value;
  902.     If Height=0 then FAspectRatio:=0 else
  903.                      FAspectRatio:=Width/Height;
  904.   End;
  905. end;
  906.  
  907. procedure TRatio.SetAspectRatio(Value:Single);
  908. begin
  909.   If (FAspectRatio<>Value) then
  910.   Begin
  911.     FAspectRatio:=Value;
  912.     FWidth:=100;
  913.     If Value=0 then FHeight:=0 else
  914.                     FHeight:=Trunc(100/value);
  915.  End;
  916. End;
  917.  
  918. destructor TResize.Destroy;
  919. begin
  920.   FRatio.Free;
  921.   inherited Destroy;
  922. end;
  923.  
  924. constructor TResize.Create;
  925. begin
  926.   inherited Create;
  927.   FRatio       := TRatio.Create;
  928.   FBorderWidth := 2;
  929. end;
  930.  
  931. procedure TResize.SetRatio(Value:TRatio);
  932. begin
  933.   FRatio.Assign(Value);
  934. end;
  935.  
  936. constructor TMargin.Create;
  937. begin
  938.   inherited Create;
  939.   LeftMin   := -5;
  940.   LeftMax   := 10;
  941.   RightMin  := -5;
  942.   RightMax  := 10;
  943.   TopMin    := -5;
  944.   TopMax    := 10;
  945.   BottomMin := -5;
  946.   BottomMax := 10;
  947.   Enabled   := False;
  948. end;
  949.  
  950. destructor TPlacement.Destroy;
  951. begin
  952.   FMargin.Free;
  953.   inherited Destroy;
  954. end;
  955.  
  956. constructor TPlacement.Create(Parent:tForm);
  957. begin
  958.   FMargin    := TMargin.Create;
  959.   ParentForm := Parent;
  960.   inherited Create;
  961. end;
  962.  
  963. Procedure TPlacement.SetTopMost(Value:tFormTopMostStyle);
  964. Begin
  965.   if Value<>FTopMost then
  966.   Begin
  967.     FTopMost := Value;
  968.     If Not Designing then TopMostAction;
  969.   End;
  970. End;
  971.  
  972. Procedure TPlacement.TopMostAction;
  973. Begin
  974.   If (FTopMost=ftmsAlways) then
  975.    SetWindowPos(ParentForm.Handle, HWND_TOPMOST, 0,0,0,0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE) else
  976.    SetWindowPos(ParentForm.Handle, HWND_NOTOPMOST,0,0,0,0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  977. End;
  978.  
  979.  
  980. constructor TCoverGradient.Create;
  981. Begin
  982.   inherited Create;
  983.   FSource:=clBlue;
  984.   FDestination:=clNavy;
  985. End;
  986.  
  987. destructor TCoverGradient.Destroy;
  988. Begin
  989.   inherited Destroy;
  990. End;
  991.  
  992. constructor TCoverImage.Create;
  993. Begin
  994.   inherited Create;
  995.   FClient:=tBitmap.Create;
  996.   FDrawMethod:=dmTile;
  997. End;
  998.  
  999. destructor TCoverImage.Destroy;
  1000. Begin
  1001.   FClient.Free;
  1002.   inherited Destroy;
  1003. End;
  1004.  
  1005. procedure TCoverImage.SetClient(Value:tBitmap);
  1006. Begin
  1007.   If (Value<>FClient) then
  1008.   begin
  1009.     FClient.Free;
  1010.     FClient:=tBitmap.Create;
  1011.     FClient.Assign(Value);
  1012.   End;
  1013. End;
  1014.  
  1015. Procedure TCoverImage.SetDrawMethod(Value:tDrawMethod);
  1016. Begin
  1017.   if (Value<>FDrawMethod) then
  1018.   Begin
  1019.     FDrawMethod:=Value;
  1020.   End;
  1021. End;
  1022.  
  1023. constructor TCover.Create;
  1024. Begin
  1025.   inherited Create;
  1026.   FCoverImage := tCoverImage.Create;
  1027.   FCoverGradient := tCoverGradient.Create;
  1028. End;
  1029.  
  1030. destructor TCover.Destroy;
  1031. Begin
  1032.   FCoverGradient.Free;
  1033.   FCoverImage.Free;
  1034.   inherited Destroy;
  1035. End;
  1036.  
  1037. procedure TFormEx.SaveSettings;
  1038. Begin
  1039.   If Not FormSaver.Enabled then Exit;
  1040.  
  1041.   With TRegistry.Create do
  1042.   Begin
  1043.     If FormSaver.Global then
  1044.     RootKey:=HKEY_LOCAL_MACHINE else
  1045.     RootKey:=HKEY_CURRENT_USER;
  1046.     If OpenKey(FormSaver.KeyName,true) then
  1047.     Begin
  1048.       If FormSaver.Size then
  1049.       Begin
  1050.         WriteInteger('Width',ParentForm.Width);
  1051.         WriteInteger('Height',ParentForm.Height);
  1052.       End;
  1053.       If FormSaver.Position then
  1054.       Begin
  1055.         WriteInteger('X',ParentForm.Left);
  1056.         WriteInteger('Y',ParentForm.Top);
  1057.       End;  
  1058.     End;
  1059.  
  1060.   End;
  1061.  
  1062. End;
  1063.  
  1064. procedure TFormEx.LoadSettings;
  1065. Begin
  1066.   If Not FormSaver.Enabled then Exit;
  1067.  
  1068.   With TRegistry.Create do
  1069.   Begin
  1070.  
  1071.     If FormSaver.Global then
  1072.     RootKey:=HKEY_LOCAL_MACHINE else
  1073.     RootKey:=HKEY_CURRENT_USER;
  1074.     If OpenKey(FormSaver.KeyName,False) then
  1075.     Begin
  1076.       If FormSaver.Size then
  1077.       Begin
  1078.         If ValueExists('Width') then
  1079.          ParentForm.Width:=ReadInteger('Width');
  1080.         If ValueExists('Height') then
  1081.          ParentForm.Height:=ReadInteger('Height');
  1082.       End;
  1083.       If FormSaver.FPosition then
  1084.       Begin
  1085.         If ValueExists('X') then
  1086.          ParentForm.Left:=ReadInteger('X');
  1087.         If ValueExists('Y') then
  1088.          ParentForm.Top:=ReadInteger('Y');
  1089.       End;
  1090.     End;
  1091.  
  1092.   End;
  1093. End;
  1094.  
  1095. constructor tCaptionScroll.Create(Parent:tForm);
  1096. begin
  1097.   inherited Create;
  1098.   ParentForm:= Parent;
  1099.   ParentHwnd:= Parent.Handle;
  1100.   FInterval := 200;
  1101.   FSpace    := '     ';
  1102.   TmpCount  := 1;
  1103.   OldAppCaption  := Application.Title;
  1104.   OldFormCaption := Parent.Caption;
  1105.   FCaption  := Parent.Caption;
  1106. end;
  1107.  
  1108. destructor tCaptionScroll.Destroy;
  1109. begin
  1110.   inherited Destroy;
  1111. end;
  1112.  
  1113. procedure tCaptionScroll.SetCaption(Value: String);
  1114. begin
  1115.   if (FCaption <> Value) then
  1116.    begin
  1117.     FCaption := Value;
  1118.     If Not Designing then
  1119.     Begin
  1120.      If (ParentForm.Caption='') then
  1121.      begin
  1122.       ParentForm.Caption := Value;
  1123.      End;
  1124.      if FIsMainWindow then
  1125.        Application.Title := Value;
  1126.       TmpCount := 1;
  1127.     End;
  1128.    end;
  1129. end;
  1130.  
  1131. Procedure tCaptionScroll.SetEnabled(Value:Boolean);
  1132. Begin
  1133.   If (Value<>FEnabled) then
  1134.   Begin
  1135.     FEnabled:=Value;
  1136.     If Not Designing then
  1137.     Begin
  1138.       If FEnabled then
  1139.       Begin
  1140.        Timer:=TTimer.Create(nil);
  1141.        Timer.OnTimer:=OnTimer;
  1142.        Timer.Interval:=FInterval;
  1143.        Timer.Enabled:=True;
  1144.        ParentForm.Caption := FCaption;
  1145.        if FIsMainWindow then  Application.Title := FCaption;
  1146.        TmpCount := 1;
  1147.       End else
  1148.       If Not FEnabled then
  1149.       Begin
  1150.        If Assigned(Timer) then
  1151.         Timer.Free;
  1152.        Application.Title:=OldAppCaption;
  1153.        ParentForm.Caption:=OldFormCaption;
  1154.       End;
  1155.     End;
  1156.   End;
  1157. End;
  1158.  
  1159. procedure tCaptionScroll.SetInterval(Value: Word);
  1160. begin
  1161.   if (Value <> FInterval) then
  1162.   begin
  1163.     FInterval := Value;
  1164.     Timer.Interval:=Value;
  1165.   end;
  1166. end;
  1167.  
  1168. Procedure TCaptionScroll.OnTimer(Sender: TObject);
  1169. Begin
  1170.  ProcessCaption;
  1171. End;
  1172.  
  1173. procedure tCaptionScroll.ProcessCaption;
  1174. var
  1175.   St: String;
  1176.   MaxCaptionLength : Integer;
  1177. begin
  1178.   try
  1179.    St := FCaption + FSpace;
  1180.    ParentForm.Caption := Copy(St, TmpCount, Length(St) - TmpCount + 1) + Copy(St, 1, TmpCount - 1);
  1181.    if FIsMainWindow then Application.Title := ParentForm.Caption;
  1182.    if Direction = dLeft then
  1183.     begin
  1184.      inc(TmpCount);
  1185.      if TmpCount > Length(St) then TmpCount := 1;
  1186.     end
  1187.    else
  1188.     begin
  1189.      dec(TmpCount);
  1190.      if TmpCount = 0 then TmpCount := Length(St);
  1191.     end;
  1192.   except
  1193.   end;
  1194. end;
  1195.  
  1196. constructor TAnimatedIcon.Create(Parent:tForm);
  1197. begin
  1198.   inherited Create;
  1199.   ParentForm:= Parent;
  1200.   FDelay    := 200;
  1201. end;
  1202.  
  1203. destructor TAnimatedIcon.Destroy;
  1204. begin
  1205.   inherited Destroy;
  1206. end;
  1207.  
  1208. Procedure TAnimatedIcon.SetEnabled(Value:Boolean);
  1209. Begin
  1210.   If (Value<>FEnabled) then
  1211.   Begin
  1212.     FEnabled:=Value;
  1213.     If Not Designing then
  1214.     Begin
  1215.       If FEnabled then
  1216.       Begin
  1217.        Ic:=tIcon.Create;
  1218.        Timer:=TTimer.Create(nil);
  1219.        Timer.OnTimer:=OnTimer;
  1220.        Timer.Interval:=FDelay;
  1221.        Timer.Enabled:=True;
  1222.        FIndex:=0;
  1223.       End else
  1224.       If Not FEnabled then
  1225.       Begin
  1226.        If Assigned(Timer) then
  1227.         Timer.Free;
  1228.        If Assigned(IC) then
  1229.         Ic.Free;
  1230.       End;
  1231.     End;
  1232.   End;
  1233. End;
  1234.  
  1235. Procedure TAnimatedIcon.OnTimer(Sender: TObject);
  1236. Begin
  1237.  If Assigned(Icons) then
  1238.  Begin
  1239.   Icons.GetIcon(FIndex,Ic);
  1240.   Inc(FIndex);
  1241.   ParentForm.Icon:=Ic;
  1242.   If FIndex>Icons.Count then FIndex:=0;
  1243.  End;
  1244. End;
  1245.  
  1246. constructor TAppearance.Create(Parent:tForm);
  1247. Begin
  1248.   inherited Create;
  1249.   ParentForm     := Parent;
  1250.   ParentHwnd     := Parent.Handle;
  1251.   OldStyleEx     := GetWindowLong(ParentHwnd,GWL_EXSTYLE);
  1252.   FShowTitleBar  := True;
  1253.   FShapePoints   := tStringList.Create;
  1254.   FCover         := TCover.Create;
  1255.   FCaptionScroll := tCaptionScroll.Create(ParentForm);
  1256.   FAlwaysMinimize:= False;
  1257.   FAnimatedIcon  := TAnimatedIcon.Create(ParentForm);
  1258. End;
  1259.  
  1260. destructor TAppearance.Destroy;
  1261. Begin
  1262.   FAnimatedIcon.Free;
  1263.   FCaptionScroll.Free;
  1264.   FCover.Free;
  1265.   FShapePoints.Free;
  1266.   inherited Destroy;
  1267. End;
  1268.  
  1269. Procedure TAppearance.ApplyShape;
  1270. Var Index     : Integer;
  1271.     ArrPoints : Array of TPoint;
  1272.     MainhRgn  : hRgn;
  1273.     X,Y       : Integer;
  1274.  
  1275. Procedure ParsePoint(Point:String;var X,Y:Integer);
  1276. Begin
  1277.  X:=StrToInt(Copy(Point,1,Pos(',',Point)-1))+1;
  1278.  Y:=StrToInt(Copy(Point,Pos(',',Point)+1, Length(Point) - Pos(',',Point)+1))+1;
  1279. End;
  1280.  
  1281. Begin
  1282.   If (FShapePoints.Count<>0) And Not Designing then
  1283.   Begin
  1284.     SetLength(ArrPoints, FShapePoints.Count);
  1285.     For Index:=0 to FShapePoints.Count-1 do
  1286.     Begin
  1287.       ParsePoint(FShapePoints[Index],X,Y);
  1288.       ArrPoints[Index].X:=X;
  1289.       ArrPoints[Index].Y:=Y;
  1290.     End;
  1291.     MainhRgn:=CreatePolygonRgn(ArrPoints[0],FShapePoints.Count,2);
  1292.     SetWindowRgn(ParentHwnd,MainhRgn,True);
  1293.   End;
  1294. End;
  1295.  
  1296. Procedure TAppearance.RemoveShape;
  1297. Begin
  1298.   SetWindowRgn(ParentHwnd,0,True);
  1299. End;
  1300.  
  1301. Procedure TAppearance.SetShapePoints(Value : tStrings);
  1302. Begin
  1303.  If Value<>FShapePoints then
  1304.  Begin
  1305.   FShapePoints.Assign(Value);
  1306.  End;
  1307. End;
  1308.  
  1309. Procedure TAppearance.SetAcceptFiles(Value: Boolean);
  1310. Begin
  1311.   If (Value <> FAcceptFiles) then
  1312.   Begin
  1313.     FAcceptFiles := Value;
  1314.     If Not Designing then
  1315.       DragAcceptFiles(ParentHwnd, FAcceptFiles)
  1316.   End;
  1317. End;
  1318.  
  1319. Procedure TAppearance.SetShowOnTaskBar(Value:tFormTaskStyle);
  1320. Begin
  1321.   If Value<>FShowOnTaskBar then
  1322.   Begin
  1323.     FShowOnTaskBar:=Value;
  1324.     If Not Designing then TaskAction;
  1325.   End;
  1326. End;
  1327.  
  1328. Procedure TAppearance.TaskAction;
  1329. begin
  1330.   If (FShowOnTaskBar<>ftsDefault) then
  1331.   Begin
  1332.     If (FShowOnTaskBar=ftsAlways) then
  1333.     Begin
  1334.     If (GetWindowLong(ParentHwnd,GWL_EXSTYLE) and WS_EX_APPWINDOW)<>WS_EX_APPWINDOW then
  1335.         SetWindowLong(ParentHwnd,GWL_EXSTYLE,OldStyleEX or (WS_EX_APPWINDOW or WS_EX_CONTROLPARENT));
  1336.     End else
  1337.     If (FShowOnTaskBar=ftsWhenVisible) and IsWindowVisible(ParentHwnd) then
  1338.     Begin
  1339.       If (GetWindowLong(ParentHwnd,GWL_EXSTYLE) and WS_EX_APPWINDOW)<>WS_EX_APPWINDOW then
  1340.         SetWindowLong(ParentHwnd,GWL_EXSTYLE,OldStyleEX or (WS_EX_APPWINDOW or WS_EX_CONTROLPARENT))
  1341.     End else
  1342.     If (FShowOnTaskBar=ftsWhenVisible) and Not IsWindowVisible(ParentHwnd) then
  1343.         SetWindowLong(ParentHwnd,GWL_EXSTYLE,OldStyleEX);
  1344.   End else
  1345.   Begin
  1346.      SetWindowLong(ParentHwnd,GWL_EXSTYLE,OldStyleEX);
  1347.   End;
  1348.  
  1349.   If not Designing then
  1350.     DragAcceptFiles(ParentHwnd, FAcceptFiles)
  1351. End;
  1352.  
  1353.  
  1354. procedure TAppearance.SetShowTitlebar(value: boolean);
  1355. Begin
  1356.  If (Value<>FShowTitleBar) then
  1357.  Begin
  1358.   FShowTitleBar := Value;
  1359.   If Not Designing then TitleBarAction;
  1360.  End;
  1361. End;
  1362.  
  1363. Procedure TAppearance.TitleBarAction;
  1364. Var
  1365.   Save : LongInt;
  1366. Begin
  1367.   If ParentForm = nil then exit;
  1368.   With ParentForm do
  1369.   begin
  1370.     case BorderStyle of
  1371.      bsNone,
  1372.      bsSizeToolWin,
  1373.      bsToolWindow: Exit;
  1374.     end;
  1375.  
  1376.     Save:=GetWindowLong(Handle,GWL_STYLE);
  1377.  
  1378.     If (Save and WS_CAPTION)=WS_CAPTION then
  1379.     Begin
  1380.       Case BorderStyle of
  1381.         bsSingle,
  1382.         bsSizeable : SetWindowLong(Handle,gwl_Style,Save and
  1383.                    (Not(ws_Caption)) or ws_border);
  1384.         bsDialog : SetWindowLong(Handle,gwl_Style,Save and
  1385.                    (Not(ws_Caption)) or ds_modalframe or ws_dlgframe);
  1386.       End;
  1387.  
  1388.       If Not FShowTitleBar then
  1389.       begin
  1390.         Height:=Height + getSystemMetrics(SM_CYCAPTION);
  1391.       end else
  1392.         Height:=Height - getSystemMetrics(SM_CYCAPTION);
  1393.  
  1394.       if FShowTitleBar then
  1395.       begin
  1396.         Height:=Height - getSystemMetrics(SM_CYCAPTION);
  1397.       end else
  1398.         Height:=Height + getSystemMetrics(SM_CYCAPTION);
  1399.  
  1400.       Refresh;
  1401.     End;
  1402.   End;
  1403. end;
  1404.  
  1405. Procedure TAppearance.SetCover(Value:tCover);
  1406. Begin
  1407.  If (Value<>FCover) then
  1408.  begin
  1409.   FCover:=Value;
  1410.  End;
  1411. End;
  1412.  
  1413. Procedure TAppearance.SetCursor(Value : tFilename);
  1414. Begin
  1415.  If (Value<>FCursor) then
  1416.  Begin
  1417.   FCursor:=Value;
  1418.   Screen.Cursors[crFormExCursor]:=LoadCursorFromFile(Pchar(FCursor));
  1419.   ParentForm.Cursor := crFormExCursor;
  1420.  End;
  1421. End;
  1422.  
  1423. Procedure TAppearance.SetFullScreen(value:boolean);
  1424. Begin
  1425.  If (Value<>FFullscreen) Then
  1426.  Begin
  1427.    FFullScreen := Value;
  1428.    If FFullscreen Then
  1429.    Begin
  1430.      if not Designing then
  1431.      Begin
  1432.       Old:=Getwindowlong(ParentHwnd, Gwl_Style);
  1433.       Setwindowlong(ParentHwnd, Gwl_Style, Getwindowlong(ParentHwnd, Gwl_Style) And Not Ws_Caption);
  1434.       Oldh:=ParentForm.Height;
  1435.       Oldw:=ParentForm.Width;
  1436.       Oldx:=ParentForm.Left;
  1437.       Oldy:=ParentForm.Top;
  1438.       Olds:=ParentForm.Windowstate;
  1439.       ParentForm.Windowstate:=Wsmaximized;
  1440.       ParentForm.Clientheight:=Screen.Height;
  1441.       ParentForm.Refresh;
  1442.      End;
  1443.    End
  1444.    Else
  1445.    Begin
  1446.      if not Designing then
  1447.      Begin
  1448.       Setwindowlong(ParentHwnd, Gwl_Style, Old);
  1449.       ParentForm.Height:=Oldh;
  1450.       ParentForm.Width:=Oldw;
  1451.       ParentForm.Left:=Oldx;
  1452.       ParentForm.Top:=Oldy;
  1453.       ParentForm.Windowstate:=Olds;
  1454.       ParentForm.Refresh;
  1455.      End;
  1456.    End;
  1457.  End;
  1458. End;
  1459.  
  1460. Procedure TAppearance.SetAlwaysMinimize(Value:Boolean);
  1461. Begin
  1462.   If (Value<>FAlwaysMinimize) then
  1463.   Begin
  1464.     FAlwaysMinimize:=Value;
  1465.   End;
  1466. End;
  1467.  
  1468. procedure TFormEx.NewParentWndProc(var Message:TMessage);
  1469. var SkipOldWndProc : Boolean;
  1470.     Pos            : tPoint;
  1471.     CPos           : tPoint;
  1472.     Files          : tStrings;
  1473.     FileCount      : Integer;
  1474.     Index          : Integer;
  1475.     Filename       : ShortString;
  1476.     IsLeft         ,
  1477.     IsRight        ,
  1478.     IsTop          ,
  1479.     IsBottom       : Boolean;
  1480.     PR             : PRect;
  1481.     I              : Integer;
  1482.  
  1483.     DCH            : HDC;
  1484.     PS             : TPaintStruct;
  1485.  
  1486. Begin
  1487.   SkipOldWndProc:=False;
  1488.  
  1489.   With Message do
  1490.   Begin
  1491.  
  1492.     If IgnoreNextMessage then
  1493.     begin
  1494.       Result := CallWindowProc(PrevParentWndProc, ParentHwnd, Msg, WParam, LParam);
  1495.       IgnoreNextMessage:=False;
  1496.       Exit;
  1497.     End;
  1498.  
  1499.     { Try to handle Window Message }
  1500.     If (Msg=WM_FONTCHANGE) then
  1501.     Begin
  1502.       If Assigned(FOnFontChange) then
  1503.         FOnFontChange(Self);
  1504.     End else
  1505.  
  1506.     if (Msg = WM_ENTERSIZEMOVE) then
  1507.     Begin
  1508.       If Assigned(FOnBeginSizeMove) then
  1509.         FOnBeginSizeMove(Self);
  1510.     End else
  1511.  
  1512.     if (Msg = WM_EXITSIZEMOVE) then
  1513.     Begin
  1514.       If Assigned(FOnEndSizeMove) then
  1515.         FOnEndSizeMove(Self);
  1516.     End else
  1517.  
  1518.     if (Msg = WM_QUERYOPEN) then
  1519.     Begin
  1520.       If FAppearance.AlwaysMinimize then
  1521.       begin
  1522.        SkipOldWndProc:=True;
  1523.        Result:=0;
  1524.       End;
  1525.     End else
  1526.  
  1527.     if (Msg=WM_ERASEBKGND) then
  1528.     Begin
  1529.       If FAppearance.Cover.Style<>fcsnone then
  1530.       Begin
  1531.         DrawBG;
  1532.         SkipOldWndProc:=True;
  1533.         Result:=1;
  1534.       End;
  1535.     End else
  1536.  
  1537.     If (Msg=WM_SIZE) then
  1538.     Begin
  1539.     End else
  1540.  
  1541.     If (Msg=WM_MOVE) then
  1542.     Begin
  1543.     End else
  1544.  
  1545.     If (Msg=WM_MOVING) then
  1546.  
  1547.     With FPlacement do
  1548.     Begin
  1549.       PR := Pointer(LParam);
  1550.  
  1551.       If ((PR^.left < Margin.LeftMax) and (PR^.Left > Margin.LeftMin) and (Margin.Enabled)) or
  1552.          ((AlwaysOnScreen) and (PR^.Left < 0))then
  1553.       Begin
  1554.         PR^.Left  := 0;
  1555.         PR^.Right := ParentForm.Width;
  1556.       End;
  1557.  
  1558.       If ((PR^.Top < Margin.TopMax) and (PR^.Top > Margin.TopMin) and (Margin.Enabled)) or
  1559.          ((AlwaysOnScreen) and (PR^.Top < 0)) then
  1560.       begin
  1561.         PR^.Top := 0;
  1562.         PR^.Bottom := ParentForm.Height;
  1563.       end;
  1564.  
  1565.       if ((PR^.Bottom > screen.Height-Margin.BottomMax) and
  1566.          (PR^.Bottom+Margin.BottomMin < screen.Height) and (Margin.Enabled)) or
  1567.          ((AlwaysOnScreen) and (PR^.Bottom>screen.height)) then
  1568.       begin
  1569.         PR^.Bottom := Screen.Height;
  1570.         PR^.Top    := Screen.Height - ParentForm.Height;
  1571.       end;
  1572.  
  1573.       if ((PR^.Right > Screen.Width - Margin.RightMax) and
  1574.           (PR^.Right + Margin.RightMin < Screen.Width) and (Margin.Enabled)) or
  1575.          ((AlwaysOnScreen) and (PR^.Right > Screen.Width)) then
  1576.       begin
  1577.         PR^.Right := Screen.Width;
  1578.         PR^.Left :=  Screen.Width - ParentForm.width;
  1579.       end;
  1580.       Result := CallWindowProc(PrevParentWndProc, ParentHwnd, Msg, WParam, LParam);
  1581.  
  1582.     End else
  1583.  
  1584.     If (Msg=WM_GETMINMAXINFO) then
  1585.     Begin
  1586.       Result := CallWindowProc(PrevParentWndProc, ParentHwnd, Msg, WParam, LParam);
  1587.       With PMinMaxInfo(lParam)^ do
  1588.       Begin
  1589.         With FResize do
  1590.         Begin
  1591.           if (FMaxWidth  <> 0) then ptMaxTrackSize.X := FMaxWidth;
  1592.           if (FMaxHeight <> 0) then ptMaxTrackSize.Y := FMaxHeight;
  1593.           if (FMinWidth  <> 0) then ptMinTrackSize.X := FMinWidth;
  1594.           if (FMinHeight <> 0) then ptMinTrackSize.Y := FMinHeight;
  1595.         End;
  1596.       End;
  1597.     End else
  1598.  
  1599.     If (Msg=WM_SIZING) then
  1600.     Begin
  1601.       If (Resize.Ratio.Enabled  And
  1602.          (Resize.Ratio.AspectRatio<>0))  Then
  1603.       Begin
  1604.         PR := Pointer(LParam);
  1605.         If WParam = WMSZ_LEFT then
  1606.           PR^.Bottom := PR^.Top  + trunc((PR^.Right-PR^.Left) / Resize.Ratio.AspectRatio) else
  1607.         If WParam = WMSZ_RIGHT then
  1608.           PR^.Bottom := PR^.Top  + trunc((PR^.Right-PR^.Left) / Resize.Ratio.AspectRatio) else
  1609.         If WParam = WMSZ_TOP then
  1610.           PR^.Right := PR^.Left  + trunc((PR^.Bottom-PR^.Top)*Resize.Ratio.AspectRatio) else
  1611.         If WParam = WMSZ_BOTTOM then
  1612.           PR^.Right := PR^.Left  + trunc((PR^.Bottom-PR^.Top)*Resize.Ratio.AspectRatio) else
  1613.         If WParam = WMSZ_BOTTOMRIGHT then
  1614.           PR^.Right := PR^.Left  + trunc((PR^.Bottom-PR^.Top)*Resize.Ratio.AspectRatio) else
  1615.         If WParam = WMSZ_BOTTOMLEFT  then
  1616.           PR^.Left  := PR^.Right - trunc((PR^.Bottom-PR^.Top)*Resize.Ratio.AspectRatio) else
  1617.         If WParam = WMSZ_TOPLEFT     then
  1618.           PR^.Left  := PR^.Right - trunc((PR^.Bottom-PR^.Top)*Resize.Ratio.AspectRatio) else
  1619.         If WParam = WMSZ_TOPRIGHT    then
  1620.           PR^.Right := PR^.Left  + trunc((PR^.Bottom-PR^.Top)*Resize.Ratio.AspectRatio);
  1621.         SkipOldWndProc := True;
  1622.       End;
  1623.     End else
  1624.  
  1625.     If (Msg=WM_SYSCOMMAND) then
  1626.     Begin
  1627.     
  1628.       If (WParam>SysMenuExID) and (FSysMenuEx<>nil) then
  1629.       Begin
  1630.         For I:=0 to FSysMenuEx.Items.Count-1 do
  1631.         Begin
  1632.           If FSysMenuEx.Items[I].Tag=WParam-SysMenuExID then
  1633.            FSysMenuEx.Items[I].Click;
  1634.         End;
  1635.       End;
  1636.       
  1637.       if (WParam=SC_MINIMIZE) then
  1638.       Begin
  1639.         If Assigned(FOnMinimize) then FOnMinimize(Self);
  1640.         If (FAppearance.ShowOnTaskBar=ftsAlways) then
  1641.         Begin
  1642.           SkipOldWndProc:=True;
  1643.           ShowWindow(ParentHwnd,SW_MINIMIZE);
  1644.         End;
  1645.       End else
  1646.       if (WParam=SC_MAXIMIZE) then
  1647.       Begin
  1648.         If Assigned(FOnMaximize) then FOnMaximize(Self);
  1649.         If (FAppearance.ShowOnTaskBar=ftsAlways) then
  1650.         Begin
  1651.           SkipOldWndProc:=True;
  1652.           ShowWindow(ParentHwnd,SW_MAXIMIZE);
  1653.         End;
  1654.       End else
  1655.       If (WParam=SC_RESTORE) then
  1656.       Begin
  1657.         If Assigned(FOnRestore) then FOnRestore(Self);
  1658.         If (FAppearance.ShowOnTaskBar=ftsAlways) then
  1659.         Begin
  1660.           SkipOldWndProc:=True;
  1661.           ShowWindow(ParentHwnd,SW_RESTORE);
  1662.         End;
  1663.       End;
  1664.     End else
  1665.  
  1666.     If (Msg=WM_SHOWWINDOW) then
  1667.     Begin
  1668.  
  1669.       if Bool(Wparam) then
  1670.       Begin
  1671.         LoadSettings;
  1672.       End else
  1673.       Begin
  1674.         { Hide }
  1675.       End;
  1676.  
  1677.     End else
  1678.  
  1679.     If (Msg=WM_DROPFILES) then
  1680.     Begin
  1681.       If Not Designing then
  1682.       Begin
  1683.  
  1684.         If (FPlacement.TopMost=ftmsWhenAcceptFiles) then
  1685.           SetForegroundWindow(ParentHwnd);
  1686.  
  1687.         DragQueryPoint(wParam, Pos);
  1688.  
  1689.         Files := TStringList.Create;
  1690.         Try
  1691.           FileCount := DragQueryFile(wParam, UINT(-1), nil, 0);
  1692.  
  1693.           For Index := 0 to (FileCount - 1) do
  1694.           Begin
  1695.             I:=DragQueryFile(wParam, Index, @Filename[1], 255);
  1696.             Filename[0]:=Char(I);
  1697.             Files.Add(Filename);
  1698.           End;
  1699.           
  1700.           If (FileCount > 0) and Assigned(FOnDropFiles) then
  1701.             FOnDropFiles(Self, Files, Pos);
  1702.         Finally
  1703.           Files.Free;
  1704.         End;
  1705.       End;
  1706.     End else
  1707.  
  1708.     If (Msg=WM_WINDOWPOSCHANGING) then
  1709.     Begin
  1710.       If (FPlacement.Moveable=fmsNever) then
  1711.       Begin
  1712.         PWindowPos(Lparam).X:=ParentForm.Left;
  1713.         PWindowPos(Lparam).Y:=ParentForm.Top;
  1714.         SkipOldWndProc:=True;
  1715.         Result:=0
  1716.       End;
  1717.     End else
  1718.   
  1719.     If (Msg=WM_NCHITTEST) then
  1720.     Begin
  1721.       Pos.x:=LoWord(LParam);
  1722.       Pos.y:=HiWord(LParam);
  1723.  
  1724.       If Assigned(FOnNonClientClick) then FOnNonClientClick(Self,Pos);
  1725.  
  1726.  
  1727.       Result := CallWindowProc(PrevParentWndProc, ParentHwnd, Msg, WParam, LParam);
  1728.       SkipOldWndProc:=True;
  1729.  
  1730.       If FResize.Enabled then
  1731.       Begin
  1732.  
  1733.         CPos := ParentForm.ScreenToClient(Pos);
  1734.  
  1735.         IsLeft   := CPos.X < FResize.BorderWidth;
  1736.         IsTop    := Pos.Y < ParentForm.Top + FResize.BorderWidth;
  1737.         IsRight  := CPos.X + FResize.BorderWidth >= ParentForm.ClientWidth;
  1738.         IsBottom := CPos.Y + FResize.BorderWidth >= ParentForm.ClientHeight;
  1739.  
  1740.         If IsLeft then
  1741.           If IsTop    then Result:=HTTOPLEFT else
  1742.           If IsBottom then Result:=HTBOTTOMLEFT else
  1743.                            Result:=HTLEFT
  1744.         else
  1745.         If IsRight then
  1746.           If isTop then    Result:=HTTOPRIGHT else
  1747.           If isBottom then Result:=HTBOTTOMRIGHT else
  1748.                            Result:=HTRIGHT
  1749.         else
  1750.         If IsTop then
  1751.           Result:=HTTOP
  1752.         else
  1753.         If IsBottom then
  1754.           Result:=HTBOTTOM;
  1755.       end;
  1756.  
  1757.       If (Result=HTCLIENT) and (FPlacement.Moveable=fmsAlways) then
  1758.       Begin
  1759.         Result:=HTCAPTION;
  1760.  
  1761.         Pos:=ParentForm.ScreenToClient(Pos);
  1762.         if (ParentForm is TForm) then
  1763.         with (ParentForm as TForm) do
  1764.         begin
  1765.           for i := 0 to ComponentCount - 1 do
  1766.           Begin
  1767.             if Components[i] is TGraphicControl then
  1768.             Begin
  1769.               With (Components[i] as TGraphicControl) do
  1770.               Begin
  1771.                 If (Pos.X >= Left) and (Pos.X<=Left+Width) and
  1772.                    (Pos.Y >= Top ) and (Pos.Y<=Top+Height) and
  1773.                    (Align=alNone) then
  1774.                   Begin
  1775.                     Result:=htClient;
  1776.                     Break;
  1777.                   End;
  1778.               End;
  1779.             End;
  1780.           end;
  1781.         End;
  1782.  
  1783.       End else
  1784.       If (Result=HTCAPTION) and (FPlacement.Moveable=fmsNever) then
  1785.       Begin
  1786.         Result:=HTCLIENT;
  1787.       End;
  1788.       
  1789.     End else
  1790.   
  1791.     If (Msg = WM_CLOSE) or (Msg = WM_DESTROY) then
  1792.     Begin
  1793.       SaveSettings;
  1794.       SeekAndDestroy := True;
  1795.     End;
  1796.   
  1797.   
  1798.     If Not SkipOldWndProc then
  1799.       Result := CallWindowProc(PrevParentWndProc, ParentHwnd, Msg, WParam, LParam);
  1800.  
  1801.   End;
  1802. End;
  1803.   
  1804. Constructor TFormEx.Create(AOwner:TComponent);
  1805. Var P     :    Pointer;
  1806. Begin
  1807.   inherited Create(AOwner);
  1808.  
  1809.   Designing:=(csDesigning in ComponentState);
  1810.   ParentHwnd:=(AOwner as TForm).Handle;
  1811.   ParentForm:=(AOwner as TForm);
  1812.   BGBuffer:=tBitmap.Create;
  1813.  
  1814.   If Not Designing then
  1815.   Begin
  1816.     PrevParentWndProc := Pointer(GetWindowLong(ParentHwnd, GWL_WNDPROC));
  1817.     P := MakeObjectInstance(NewParentWndProc);
  1818.     SetWindowLong(ParentHwnd, GWL_WNDPROC, LongInt(p));
  1819.  
  1820. {    FormExThread := tFormExThread.Create;
  1821.     FormExThread.Resume;
  1822. }  End;
  1823.  
  1824.   { Initialize Properties }
  1825.   FFormSaver          := TFormSaver.Create;
  1826.   FFormSaver.Global   := False;
  1827.   FFormSaver.FEnabled := False;
  1828.   If Not Designing then
  1829.     FFormSaver.FKeyName := 'Software\'+Application.Title+'\'+ParentForm.Caption;
  1830.   FFormSaver.Position := True;
  1831.   FFormSaver.Size     := True;
  1832.  
  1833.   FResize               := TResize.Create;
  1834.   FResize.Ratio.Width   := ParentForm.Width;
  1835.   FResize.Ratio.Height  := ParentForm.Height;
  1836.  
  1837.   FPlacement                := TPlacement.Create(ParentForm);
  1838.   FPlacement.TopMost        := ftmsDefault;
  1839.   FPlacement.Moveable       := fmsDefault;
  1840.  
  1841.   FAppearance               := TAppearance.Create(ParentForm);
  1842.   FAppearance.ShowOnTaskBar := ftsDefault;
  1843.   FAppearance.AcceptFiles   := False;
  1844.   FAppearance.FullScreen    := False;
  1845.  
  1846.  
  1847.   FTrayIcon      := TTrayIcon.Create(ParentForm,Self);
  1848.  
  1849.   RebuildBG;
  1850. End;
  1851.  
  1852. procedure TFormEx.Loaded;
  1853. begin
  1854.   inherited Loaded;
  1855.   Placement.TopMostAction;
  1856.   Appearance.ApplyShape;
  1857. end;
  1858.  
  1859. Destructor TFormEx.destroy;
  1860. Begin
  1861.  
  1862.   If Not Designing then
  1863.   Begin
  1864. {    FormExThread.Release;
  1865. }    If not SeekAndDestroy then
  1866.      SetWindowLong(ParentHwnd, GWL_WNDPROC, LongInt(PrevParentWndProc));
  1867.  
  1868.   End;
  1869.  
  1870.   FTrayIcon.Free;
  1871.   FAppearance.Free;
  1872.   FFormSaver.Free;
  1873.   FPlacement.Free;
  1874.   FResize.Free;
  1875.  
  1876.   BGBuffer.Free;
  1877.   inherited destroy;
  1878. End;
  1879.  
  1880.  
  1881.  
  1882.  
  1883. procedure TFormEx.DrawBG;
  1884. var Width,
  1885.     Height : Integer;
  1886. Begin
  1887.  Width  := ParentForm.ClientWidth;
  1888.  Height := ParentForm.ClientHeight;
  1889.  If (BGBuffer.Width<>Width) or
  1890.     (BGBuffer.Height<>Height) then RebuildBG;
  1891.  BitBlt(ParentForm.Canvas.Handle,0,0,Width,Height,BGBuffer.Canvas.Handle,0,0,SRCCopy);
  1892. End;
  1893.  
  1894. Procedure TFormEx.BuildBGGradient;
  1895. Type
  1896.   tRGB = Record
  1897.           R, G, B : Byte;
  1898.          End;
  1899.  
  1900. Function RGBtoColor(RGB:TRGB):TColor;
  1901. Begin
  1902.  Result:=Windows.RGB(RGB.B,RGB.G,RGB.R);
  1903. End;
  1904.  
  1905. Function ColorToRGB(Color:TColor):TRGB;
  1906. Begin
  1907.  Result.R:=GetRValue(Color);
  1908.  Result.G:=GetGValue(Color);
  1909.  Result.B:=GetBValue(Color);
  1910. End;
  1911.  
  1912.  
  1913. Var
  1914.   Width    ,
  1915.   Height   ,
  1916.   Y        : Integer;
  1917.   Buffer   : tBitmap;
  1918.   Rect     : tRect;
  1919.   SourceRGB,
  1920.   DestRGB,
  1921.   CurrRGB  : tRGB;
  1922.   RMode    ,
  1923.   GMode    ,
  1924.   BMode    : Byte;
  1925. begin
  1926.   SourceRGB  := ColorToRGB(FAppearance.Cover.Gradient.Source);
  1927.   DestRGB    := ColorToRGB(FAppearance.Cover.Gradient.Destination);
  1928.  
  1929.   Width   := ParentForm.ClientWidth;
  1930.   Height  := ParentForm.ClientHeight;
  1931.  
  1932.   Buffer        := TBitmap.create;
  1933.   Buffer.Width  := Width;
  1934.   Buffer.Height := Height;
  1935.  
  1936.   CurrRGB:=SourceRGB;
  1937.   If SourceRGB.R > DestRGB.R then RMode:=2 else { Dec }
  1938.   If SourceRGB.R < DestRGB.R then RMode:=1;     { Inc }
  1939.   If SourceRGB.G > DestRGB.G then GMode:=2 else { Dec }
  1940.   If SourceRGB.G < DestRGB.G then GMode:=1;     { Inc }
  1941.   If SourceRGB.B > DestRGB.B then BMode:=2 else { Dec }
  1942.   If SourceRGB.B < DestRGB.B then BMode:=1;     { Inc }
  1943.  
  1944.   Rect.Left :=0;
  1945.   Rect.Right:=Buffer.width;
  1946.  
  1947.   For Y:=0 to 255 do
  1948.   begin
  1949.     Rect.Top    := (Y)   * Buffer.Height div 256;
  1950.     Rect.Bottom := (Y+1) * Buffer.Height div 256;
  1951.     Begin
  1952.      If CurrRGB.R <> DestRGB.R then
  1953.       If RMode = 1 then CurrRGB.R:=CurrRGB.R+1 else CurrRGB.R:=CurrRGB.R-1;
  1954.      If CurrRGB.G <> DestRGB.G then
  1955.       If GMode = 1 then CurrRGB.G:=CurrRGB.G+1 else CurrRGB.G:=CurrRGB.G-1;
  1956.      If CurrRGB.B <> DestRGB.B then
  1957.       If BMode = 1 then CurrRGB.B:=CurrRGB.B+1 else CurrRGB.B:=CurrRGB.B-1;
  1958.      Buffer.canvas.brush.color:=tcolor(rgb(CurrRGB.R,CurrRGB.G,CurrRGB.B));
  1959.     End;
  1960.     Buffer.Canvas.Fillrect(rect);
  1961.   End;
  1962.  
  1963.   BGBuffer.Free;
  1964.   BGBuffer:=tBitmap.Create;
  1965.   BGBuffer.Assign(Buffer);
  1966.   Buffer.Free;
  1967. End;
  1968.  
  1969. Procedure TFormEx.BuildBGImage;
  1970. var w,h,x,y:integer;
  1971.     Buffer:tBitmap;
  1972.     Width,Height : Integer;
  1973. Begin
  1974.   If FAppearance.Cover.Image.Image.Empty then
  1975.   Begin
  1976.     Exit;
  1977.   End;
  1978.  
  1979.   Width   := ParentForm.ClientWidth;
  1980.   Height  := ParentForm.ClientHeight;
  1981.  
  1982.   With FAppearance.Cover.Image do
  1983.   Begin
  1984.  
  1985.     Buffer:=tbitmap.create;
  1986.     Buffer.width:=Width;
  1987.     Buffer.Height:=Height;
  1988.  
  1989.     If FDrawMethod=dmNormal then
  1990.     Begin
  1991.       BitBlt(Buffer.Canvas.Handle,1,1,Image.Width,Image.Height,Image.Canvas.Handle,0,0,SRCCopy);
  1992.     End else
  1993.     If fDrawMethod=dmCenter then
  1994.     begin
  1995.       X := (Width  - Image.Width) div 2;
  1996.       Y := (Height - Image.Height) div 2;
  1997.       BitBlt(Buffer.Canvas.Handle,X,Y,Image.Width,Image.Height,Image.Canvas.Handle,0,0,SRCCopy);
  1998.     End else
  1999.     If FDrawMethod=dmStretch then
  2000.     Begin
  2001.       StretchBlt(Buffer.Canvas.Handle,1,1,Width,Height,Image.Canvas.Handle,0,0,Image.Width,Image.Height,SRCCopy);
  2002.     End else
  2003.     If FDrawMethod=dmTile then
  2004.     Begin
  2005.       X:=1;
  2006.       Y:=1;
  2007.       W:=Image.Width;
  2008.       H:=Image.Height;
  2009.  
  2010.       While (X < Width) do
  2011.       Begin
  2012.         Y:=0;
  2013.         while (Y < Height) do
  2014.         Begin
  2015.           BitBlt(Buffer.Canvas.Handle,X,Y,Image.Width,Image.Height,Image.Canvas.Handle,0,0,SRCCopy);
  2016.          Inc(Y,H);
  2017.         end;
  2018.         Inc(X,W);
  2019.       End;
  2020.     End;
  2021.  
  2022.     BGBuffer.Free;
  2023.     BGBuffer:=tBitmap.Create;
  2024.     BGBuffer.Assign(Buffer);
  2025.  
  2026.     Buffer.Free;
  2027.   End;
  2028. End;
  2029.  
  2030. Procedure TFormEx.RebuildBG;
  2031. Begin
  2032.   If FAppearance.Cover.Style=fcsImage then
  2033.    BuildBGImage else
  2034.   If FAppearance.Cover.Style=fcsGradient then
  2035.    BuildBGGradient;
  2036. end;
  2037.  
  2038. procedure TFormEx.SendKeys(WinHandle:Hwnd;Buffer:String);
  2039. Var
  2040.   I: Integer;
  2041.   W: Word;
  2042.   D: DWORD;
  2043.   P: ^DWORD;
  2044. begin
  2045.   P:=@D;
  2046.   SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT,0,P,0);
  2047.   If IsIconic(WinHandle) then
  2048.    ShowWindow(WinHandle,SW_RESTORE);
  2049.   SetForegroundWindow(WinHandle);
  2050.   For I := 1 to Length(Buffer) do
  2051.   Begin
  2052.    W:=VkKeyScan(Buffer[i]);
  2053.    keybd_event(w,0,0,0);
  2054.    keybd_event(w,0,KEYEVENTF_KEYUP,0);
  2055.   End;
  2056.   SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT,0,nil,0);
  2057.   SetForegroundWindow(ParentHwnd);
  2058.   SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT,D,nil,0);
  2059. end;
  2060.  
  2061. procedure TFormEx.CaptureWindow(WinHandle:Hwnd;Filename:String);
  2062. Var
  2063.   I         : Integer;
  2064.   W         : Word;
  2065.   D         : DWORD;
  2066.   P         : ^DWORD;
  2067.   DC        : HDC;
  2068.   Buffer    : tBitmap;
  2069.   Rect      : TRect;
  2070. begin
  2071.   P:=@D;
  2072.   SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT,0,P,0);
  2073.   If IsIconic(WinHandle) then
  2074.    ShowWindow(WinHandle,SW_RESTORE);
  2075.   SetForegroundWindow(WinHandle);
  2076.   UpdateWindow(WinHandle);
  2077.  
  2078.   GetWindowRect(WinHandle,Rect);
  2079.   DC:=GetWindowDC(WinHandle);
  2080.   Buffer:=tBitmap.Create;
  2081.   Try
  2082.    Buffer.Width:=Rect.Right-Rect.Left;
  2083.    Buffer.Height:=Rect.Bottom-Rect.Top;
  2084.    BitBlt(Buffer.Canvas.Handle,0,0,Buffer.Width,Buffer.Height,
  2085.    DC,0,0,SRCCopy);
  2086.    Buffer.SaveToFile(Filename);
  2087.   Finally
  2088.    Buffer.Free;
  2089.   End;
  2090.   ReleaseDC(WinHandle,DC);
  2091.  
  2092.   SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT,0,nil,0);
  2093.   SetForegroundWindow(ParentHwnd);
  2094.   SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT,D,nil,0);
  2095. end;
  2096.  
  2097. Procedure TFormEx.Flash(Number,Delay:Integer);
  2098. Var I:Integer;
  2099.     T:Integer;
  2100. Begin
  2101.  For I:=1 to Number do
  2102.  Begin
  2103.   FlashWindow(ParentHwnd,True);
  2104.   T:=GetTickCount; While GetTickCount-T<Delay do;
  2105.   FlashWindow(ParentHwnd,False);
  2106.   T:=GetTickCount; While GetTickCount-T<Delay do;
  2107.  End;
  2108. End;
  2109.  
  2110. Procedure tFormEx.SetSysMenuEx(Value:tPopupMenu);
  2111. var SysMenu : HMenu;
  2112.     Count   : Integer;
  2113. Begin
  2114.  If (Value<>FSysMenuEx) then
  2115.  Begin
  2116.   { Reset System Menu }
  2117.   SysMenu:=GetSystemMenu(ParentHwnd,True);
  2118.   FSysMenuEx:=Value;
  2119.   If FSysMenuEx=nil then Exit;
  2120.  
  2121.   SysMenu:=GetSystemMenu(ParentHwnd,False);
  2122.   For count:=0 to FSysMenuEx.Items.Count-1 do
  2123.   Begin
  2124.    If FSysMenuEx.Items[Count].Caption<>'-' then
  2125.    AppendMenu(SysMenu, mf_ByCommand, FSysMenuEx.Items[Count].Tag + SysMenuExID, Pchar(FSysMenuEx.Items[Count].Caption)) else
  2126.    AppendMenu(SysMenu, mf_ByCommand or MF_SEPARATOR, 0, '');
  2127.   End;
  2128.  End;
  2129. End;
  2130.  
  2131. Procedure TFormEx.CenterOnForm(Form:tForm);
  2132. Begin
  2133.  parentForm.Left:=Form.Left +((Form.ClientWidth-parentForm.Width) div 2);
  2134.  parentForm.Top :=Form.Top  +((Form.ClientHeight-parentForm.Height) div 2);
  2135. End;
  2136.  
  2137. Procedure TFormEx.HorizontalCenter(Form:tForm);
  2138. Begin
  2139.  parentForm.Left:=Form.Left +((Form.ClientWidth-parentForm.Width) div 2);
  2140. End;
  2141.  
  2142. Procedure TFormEx.VerticalCenter(Form:tForm);
  2143. Begin
  2144.  parentForm.Top :=Form.Top  +((Form.ClientHeight-parentForm.Height) div 2);
  2145. End;
  2146.  
  2147.  
  2148. // ================================================================================================
  2149. // Sizes the specified form perfectly in the Win95/NT4 client area, outside the taskbar, regardless
  2150. // of the taskbar's size or location.  Freeware by Peter M. Jagielski.
  2151. // Call from Form.Create Event !
  2152. // ================================================================================================
  2153.  
  2154. procedure TFormEx.SizeForWindowsDesktop; { Outside taskbar area }
  2155. var
  2156.   TaskBarHandle: HWnd;
  2157.   TaskBarCoord:  TRect;
  2158.   CxScreen,
  2159.   CyScreen,
  2160.   CxFullScreen,
  2161.   CyFullScreen,
  2162.   CyCaption:     Integer;
  2163. begin
  2164.   TaskBarHandle := FindWindow('Shell_TrayWnd',Nil);
  2165.   if TaskBarHandle = 0 then
  2166.     parentForm.WindowState := wsMaximized
  2167.   else
  2168.     begin
  2169.       parentForm.WindowState := wsNormal;
  2170.       GetWindowRect(TaskBarHandle,TaskBarCoord);
  2171.       CxScreen        := GetSystemMetrics(SM_CXSCREEN);
  2172.       CyScreen        := GetSystemMetrics(SM_CYSCREEN);
  2173.       CxFullScreen    := GetSystemMetrics(SM_CXFULLSCREEN);
  2174.       CyFullScreen    := GetSystemMetrics(SM_CYFULLSCREEN);
  2175.       CyCaption       := GetSystemMetrics(SM_CYCAPTION);
  2176.       parentForm.Width    := CxScreen - (CxScreen - CxFullScreen) + 1;
  2177.       parentForm.Height   := CyScreen - (CyScreen - CyFullScreen) + CyCaption + 1;
  2178.       parentForm.Top      := 0;
  2179.       parentForm.Left     := 0;
  2180.       parentForm.Position := poDefault;
  2181.       if (TaskBarCoord.Top = -2) and (TaskBarCoord.Left = -2) then
  2182.         if TaskBarCoord.Right > TaskBarCoord.Bottom then
  2183.           parentForm.Top  := TaskBarCoord.Bottom
  2184.         else
  2185.           parentForm.Left := TaskBarCoord.Right;
  2186.     end;
  2187. end;
  2188.  
  2189. procedure Register;
  2190. begin
  2191.   RegisterComponents('Jazarsoft', [TFormEx]);
  2192. end;
  2193.  
  2194. end.
  2195.