home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d456 / DCSLIB25.ZIP / DCPopupWindow.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-25  |  115KB  |  4,209 lines
  1. {
  2.  BUSINESS CONSULTING
  3.  s a i n t - p e t e r s b u r g
  4.  
  5.          Components Library for Borland Delphi 4.x, 5.x
  6.          Copyright (c) 1998-2000 Alex'EM
  7.  
  8. }
  9. unit DCPopupWindow;
  10.  
  11. interface
  12. {$I DCConst.inc}
  13.  
  14. uses
  15.   Windows, Messages, SysUtils, Classes, Controls, Forms, Graphics, StdCtrls,
  16.   {$IFDEF DELPHI_V6}
  17.     Variants,
  18.   {$ENDIF}
  19.   CommCtrl, FlatSb, DCDBGrids, DB, Grids, Dialogs, ComCtrls,
  20.   DCEditTools, DCEditButton, DCConst;
  21.  
  22.  
  23. const
  24.   br_SizerWidth    = 14;
  25.   br_FooterHeight  = 13;
  26.   br_HeaderHeight =  14;
  27.   SRCTIMER_IDEVENT = $AE;
  28.  
  29. type
  30.   PHintWindowParam_tag  = ^THintWindowParam;
  31.   THintWindowParam = record
  32.     HMode: Smallint;
  33.     HLeft: Smallint;
  34.     HTop : Smallint;
  35.     HOff : Smallint;
  36.     HPosX: Integer;
  37.     HPosY: Integer;
  38.     PHint: PChar;
  39.   end;
  40.   TClipFormOptions = set of TClipFormValue;
  41.  
  42.   TDCAssistButton = class(TDCEditButton)
  43.   private
  44.     FLine: integer;
  45.     FPos: integer;
  46.     FDrawingStyle: TDCDrawingStyle;
  47.     FDropDownColor: TColor;
  48.     procedure SetLine(const Value: integer);
  49.     procedure SetPos(const Value: integer);
  50.     procedure SetDrawingStyle(const Value: TDCDrawingStyle);
  51.   protected
  52.     procedure DrawBkgnd(ACanvas: TCanvas; ARect: TRect); override;
  53.     procedure BeginDrawText(ACanvas: TCanvas; ATextRect: TRect); override;
  54.     procedure BeginDrawBkgn(ACanvas: TCanvas; ARect: TRect;
  55.       var ImageRect: TRect; var TextRect: TRect); override;
  56.     function OneClickButton: boolean; override;
  57.   public
  58.     constructor Create(AOwner: TComponent); override;
  59.     procedure DrawBorder(ACanvas: TCanvas; ARect: TRect); override;
  60.     procedure DrawBitmap(ACanvas: TCanvas; ImageRect: TRect); override;
  61.     function GetImageOffset: TPoint; override;
  62.     function GetTextOffset: TPoint; override;
  63.     property Line: integer read FLine write SetLine;
  64.     property Pos: integer read FPos write SetPos;
  65.     property DrawingStyle: TDCDrawingStyle read FDrawingStyle write SetDrawingStyle;
  66.     property DropDownColor: TColor read FDropDownColor write FDropDownColor;
  67.   end;
  68.  
  69.   TDCPopupWindow = class(TCustomControl)
  70.   private
  71.     FVisible: boolean;
  72.     FOwner: TControl;
  73.     FWindowRect: TRect;
  74.     FAlwaysVisible: boolean;
  75.     FPopupAlignment: TWindowAlignment;
  76.     FOrientation: integer;
  77.     procedure SetPopupAlignment(Value: TWindowAlignment);
  78.   protected
  79.     procedure CreateParams(var Params: TCreateParams); override;
  80.     procedure CreateWnd; override;
  81.     procedure WMMouseActivate(var Message: TWMActivate); message WM_MOUSEACTIVATE;
  82.     procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
  83.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  84.     procedure CMShowingChanged (var Message: TMessage); message CM_SHOWINGCHANGED;
  85.     procedure SetOrientation(const Value: integer); virtual;
  86.     property WindowRect: TRect read FWindowRect;
  87.   public
  88.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  89.     procedure SetBoundsEx(ALeft, ATop, AWidth, AHeight: Integer);
  90.     constructor Create(AOwner: TComponent); override;
  91.     destructor Destroy; override;
  92.     function GetTextHeight(Value: string): integer;
  93.     function GetTextWidth(Value: string): integer;
  94.     procedure Show; virtual;
  95.     procedure Hide; virtual;
  96.     property AlwaysVisible: boolean read FAlwaysVisible write FAlwaysVisible;
  97.     property PopupAlignment: TWindowAlignment read FPopupAlignment
  98.              write SetPopupAlignment;
  99.     property Owner: TControl read FOwner write FOwner;
  100.     property Canvas;
  101.     property Parent;
  102.     property Orientation: integer read FOrientation write SetOrientation;
  103.   end;
  104.  
  105.   TDrawInfoText   = procedure (Sender: TObject; DC: HDC; Rect: TRect;
  106.     var Text: string; var Default: boolean) of object;
  107.  
  108.   TDCMessageWindow = class(TDCPopupWindow)
  109.   private
  110.     FAutoHide: boolean;
  111.     FAutoSize: boolean;
  112.     FButtons: TDCEditButtons;
  113.     FBitmap: TBitmap;
  114.     FBitmapVisible: boolean;
  115.     FDialogStyle: TDialogStyle;
  116.     FMargins: TRect;
  117.     FTimerHandle: Word;
  118.     FTimeOut: integer;
  119.     FMessageStyle: TMessageStyle;
  120.     FImage: TBitmap;
  121.     FRoundValue: integer;
  122.     FTailValue: integer;
  123.     FBitmapOffset: integer;
  124.     FCentered: boolean;
  125.     FOnDrawInfoText: TDrawInfoText;
  126.     FMaxTextWidth: integer;
  127.     FUpdateCount: integer;
  128.     procedure AdjustWindowSize;
  129.     procedure SetDialogStyle(Value: TDialogStyle);
  130.     procedure SetBitmap(Value: TBitmap);
  131.     procedure SetBitmapVisible(Value: boolean);
  132.     procedure SetAutoHide(const Value: boolean);
  133.     procedure SetTimeOut(const Value: integer);
  134.     procedure StartTimer(Value: Integer);
  135.     procedure StopTimer;
  136.     function GetRegion(RegionType: integer = 0): HRGN;
  137.     procedure SetMessageStyle(const Value: TMessageStyle);
  138.     procedure SetCentered(const Value: boolean);
  139.     procedure SetMaxTextWidth(const Value: integer);
  140.     procedure UpdateWindowRegion;
  141.     procedure SetAutoSize(const Value: boolean); reintroduce;
  142.   protected
  143.     procedure CreateWnd; override;
  144.     procedure CreateParams(var Params: TCreateParams); override;
  145.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  146.     procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  147.     procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
  148.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  149.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  150.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  151.     procedure Resize; override;
  152.     procedure SetOrientation(const Value: integer); override;
  153.     procedure SetMargins;
  154.     procedure Paint; override;
  155.   public
  156.     constructor Create(AOwner: TComponent); override;
  157.     destructor Destroy; override;
  158.     procedure Show; override;
  159.     procedure Hide; override;
  160.     function AddButton(AName, AResource, ACaption: string;
  161.       AClick: TNotifyEvent): TDCEditButton;
  162.     procedure BeginUpdate;
  163.     Procedure EndUpdate;
  164.     property Caption;
  165.     property Color;
  166.     property Canvas;
  167.     property DialogStyle: TDialogStyle read FDialogStyle write SetDialogStyle;
  168.     property Bitmap: TBitmap read FBitmap write SetBitmap;
  169.     property BitmapVisible: boolean read FBitmapVisible write SetBitmapVisible;
  170.     property Buttons: TDCEditButtons read FButtons;
  171.     property AutoHide: boolean read FAutoHide write SetAutoHide;
  172.     property TimeOut: integer read FTimeOut write SetTimeOut;
  173.     property MessageStyle: TMessageStyle read FMessageStyle write SetMessageStyle;
  174.     property Centered: boolean read FCentered write SetCentered;
  175.     property OnDrawInfoText: TDrawInfoText read FOnDrawInfoText write FOnDrawInfoText;
  176.     property MaxTextWidth: integer read FMaxTextWidth write SetMaxTextWidth;
  177.     property AutoSize: boolean read FAutoSize write SetAutoSize;
  178.   end;
  179.  
  180.   TDCPopupListBox = class(TCustomListBox)
  181.   private
  182.     FVisible: boolean;
  183.     FOwner: TControl;
  184.     FWindowRect: TRect;
  185.     FAlwaysVisible: boolean;
  186.     FPopupAlignment: TWindowAlignment;
  187.     FPopupBorderStyle: TPopupBorderStyle;
  188.     FBorderSize: integer;
  189.     FDropDownRows: integer;
  190.     procedure RedrawBorder;
  191.     procedure SetPopupAlignment(Value: TWindowAlignment);
  192.     procedure SetPopupBorderStyle(Value: TPopupBorderStyle);
  193.   protected
  194.     procedure CreateParams(var Params: TCreateParams); override;
  195.     procedure CreateWnd; override;
  196.     function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  197.       MousePos: TPoint): Boolean; override;
  198.     procedure WMMouseActivate(var Message: TWMActivate); message WM_MOUSEACTIVATE;
  199.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  200.     procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
  201.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  202.     procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
  203.     procedure WMFontChange(var Message: TWMFontChange); message WM_FONTCHANGE;
  204.   public
  205.     procedure AdjustNewHeight;
  206.     procedure SetListHeight(Increment: integer);
  207.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  208.     procedure SetBoundsEx(ALeft, ATop, AWidth, AHeight: Integer);
  209.  
  210.     constructor Create(AOwner: TComponent); override;
  211.     procedure Show;
  212.     procedure Hide;
  213.     property AlwaysVisible: boolean read FAlwaysVisible write FAlwaysVisible;
  214.     property PopupAlignment: TWindowAlignment read FPopupAlignment
  215.              write SetPopupAlignment;
  216.     property Owner: TControl read FOwner write FOwner;
  217.     property PopupBorderStyle: TPopupBorderStyle read FPopupBorderStyle write SetPopupBorderStyle;
  218.     property DropDownRows: integer read FDropDownRows write FDropDownRows;
  219.  
  220.     property Style;
  221.     property Font;
  222.     property OnDrawItem;
  223.     property OnMeasureItem;
  224.     property OnMouseUp;
  225.     property ItemHeight;
  226.     property Color;
  227.     property ListVisible: boolean read FVisible write FVisible;
  228.   end;
  229.  
  230.   TDCPopupDBGrid = class(TDCCustomDBGrid)
  231.   private
  232.     FButtons: TDCEditButtons;
  233.     FVisible: boolean;
  234.     FOwner: TControl;
  235.     FWindowRect: TRect;
  236.     FAlwaysVisible: boolean;
  237.     FPopupAlignment: TWindowAlignment;
  238.     FPopupBorderStyle: TPopupBorderStyle;
  239.     FBorderSize: integer;
  240.     FDataSet: TDataSet;
  241.     FDataSource: TDataSource;
  242.     FDropDownRows: integer;
  243.     FItemHeight: integer;
  244.     FMargins: TRect;
  245.     FCursorMode: TCursorMode;
  246.     FShowHeader: boolean;
  247.     FOnButtonClick: TNotifyEvent;
  248.     FFindButton, FScrollLeft, FScrollRight: TDCEditButton;
  249.     FCanAppend: boolean;
  250.     FScrollTimer: THandle;
  251.     procedure RedrawBorder;
  252.     procedure SetPopupAlignment(Value: TWindowAlignment);
  253.     procedure SetPopupBorderStyle(Value: TPopupBorderStyle);
  254.     procedure SetDataSet(const Value: TDataSet);
  255.     procedure DrawHeader;
  256.     procedure DrawClientRect;
  257.     procedure DrawFooter;
  258.     procedure SetMargins;
  259.     procedure BeginMoving(XCursor, YCursor: integer);
  260.     procedure DoButtonClick(Sender: TObject);
  261.     procedure InvalidateButtons;
  262.     procedure SetShowHeader(const Value: boolean);
  263.     procedure SetCanAppend(const Value: boolean);
  264.     procedure DoDrawHint(Sender: TObject; Mode: Integer);
  265.     procedure CheckRefreshButton;
  266.     procedure PaintEmptyMessage(Sender: TObject; Canvas: TCanvas; ARect: TRect;
  267.     UpdateMessage: string);
  268.     procedure DoScroll(Sender: TObject);
  269.     procedure UpdateHScrolls;
  270.   protected
  271.     procedure CreateParams(var Params: TCreateParams); override;
  272.     procedure CreateWnd; override;
  273.     procedure WMMouseActivate(var Message: TWMActivate); message WM_MOUSEACTIVATE;
  274.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  275.     procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
  276.     function  HighlightCell(DataCol, DataRow: Integer; const Value: string;
  277.       AState: TGridDrawState): Boolean; override;
  278.     procedure WMFontChange(var Message: TWMFontChange); message WM_FONTCHANGE;
  279.     procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
  280.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  281.     procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  282.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  283.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  284.     procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
  285.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  286.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  287.     procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
  288.     procedure CMSetAlignment(var Message: TMessage); message CM_SETALIGNMENT;
  289.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  290.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  291.     procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
  292.     procedure WMNCMouseMove(var Message: TWMNCMouseMove); message WM_NCMOUSEMOVE;
  293.     function  MouseUpBeforeDblClk: boolean; override;
  294.     procedure TopLeftChanged; override;
  295.   public
  296.     procedure AdjustNewHeight;
  297.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  298.     procedure SetBoundsEx(ALeft, ATop, AWidth, AHeight: Integer);
  299.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  300.     procedure KeyPress(var Key: Char);override;
  301.  
  302.     constructor Create(AOwner: TComponent); override;
  303.     destructor Destroy; override;
  304.     procedure SetParent(AParent: TWinControl); override;
  305.     procedure Show;
  306.     procedure Hide;
  307.     procedure StartSearch(Key: Char; AValue: string = '');
  308.     procedure StopSearch;
  309.     function ValidPosition: boolean;
  310.     property AlwaysVisible: boolean read FAlwaysVisible write FAlwaysVisible;
  311.     property PopupAlignment: TWindowAlignment read FPopupAlignment
  312.              write SetPopupAlignment;
  313.     property Owner: TControl read FOwner write FOwner;
  314.     property PopupBorderStyle: TPopupBorderStyle read FPopupBorderStyle write SetPopupBorderStyle;
  315.     property DataSet: TDataSet read FDataSet write SetDataSet;
  316.     property DropDownRows: integer read FDropDownRows write FDropDownRows;
  317.     property Columns;
  318.     property OnCellClick;
  319.     property OnDblClick;
  320.     property BorderStyle;
  321.     property Buttons: TDCEditButtons read FButtons;
  322.     property ShowHeader: boolean read FShowHeader write SetShowHeader;
  323.     property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
  324.     property OnTitleClick;
  325.     property CanAppend: boolean read FCanAppend write SetCanAppend;
  326.     property DataSource;
  327.     property OptionsEx;
  328.   end;
  329.  
  330.   TDCPopupTreeView = class(TCustomTreeView)
  331.   private
  332.     FVisible: boolean;
  333.     FOwner: TControl;
  334.     FWindowRect: TRect;
  335.     FAlwaysVisible: boolean;
  336.     FPopupAlignment: TWindowAlignment;
  337.     FPopupBorderStyle: TPopupBorderStyle;
  338.     FItemHeight: integer;
  339.     FBorderSize: integer;
  340.     FDropDownRows: integer;
  341.     FMargins: TRect;
  342.     FCursorMode: TCursorMode;
  343.     FButtons: TDCEditButtons;
  344.     FShowHeader: boolean;
  345.     procedure RedrawBorder;
  346.     procedure SetPopupAlignment(Value: TWindowAlignment);
  347.     procedure SetPopupBorderStyle(Value: TPopupBorderStyle);
  348.     procedure DrawHeader;
  349.     procedure DrawClientRect;
  350.     procedure DrawFooter;
  351.     procedure SetMargins;
  352.     procedure BeginMoving(XCursor, YCursor: integer);
  353.     procedure InvalidateButtons;
  354.     procedure SetShowHeader(const Value: boolean);
  355.   protected
  356.     procedure CreateParams(var Params: TCreateParams); override;
  357.     procedure CreateWnd; override;
  358.     procedure WMMouseActivate(var Message: TWMActivate); message WM_MOUSEACTIVATE;
  359.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  360.     procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
  361.     procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
  362.     procedure WMFontChange(var Message: TWMFontChange); message WM_FONTCHANGE;
  363.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  364.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  365.     procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
  366.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  367.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  368.     procedure CMSetAlignment(var Message: TMessage); message CM_SETALIGNMENT;
  369.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  370.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  371.     procedure WMActivate (var Message: TWMActivate); message WM_ACTIVATE;
  372.     procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
  373.     procedure WMShowWindow(var Message: TWMShowWindow); message WM_SHOWWINDOW;
  374.   public
  375.     procedure AdjustNewHeight;
  376.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  377.     procedure SetBoundsEx(ALeft, ATop, AWidth, AHeight: Integer);
  378.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  379.     procedure KeyPress(var Key: Char);override;
  380.  
  381.     constructor Create(AOwner: TComponent); override;
  382.     destructor Destroy; override;
  383.     procedure SetParent(AParent: TWinControl); override;
  384.     procedure Show;
  385.     procedure Hide;
  386.     property AlwaysVisible: boolean read FAlwaysVisible write FAlwaysVisible;
  387.     property PopupAlignment: TWindowAlignment read FPopupAlignment
  388.              write SetPopupAlignment;
  389.     property Owner: TControl read FOwner write FOwner;
  390.     property PopupBorderStyle: TPopupBorderStyle read FPopupBorderStyle write SetPopupBorderStyle;
  391.     property DropDownRows: integer read FDropDownRows write FDropDownRows;
  392.     property OnDblClick;
  393.     property BorderStyle;
  394.     property Buttons: TDCEditButtons read FButtons;
  395.     property Color;
  396.     property Items;
  397.     property Images;
  398.     property OnChange;
  399.     property OnCollapsed;
  400.     property OnExpanded;
  401.     property OnCollapsing;
  402.     property OnExpanding;
  403.     property OnKeyPress;
  404.     property Caption;
  405.     property ShowHeader: boolean read FShowHeader write SetShowHeader;
  406.     property OnCustomDrawItem;
  407.   end;
  408.  
  409.   TDCClipPopup = class(TDCPopupWindow)
  410.   private
  411.     FButtons: TDCEditButtons;
  412.     FCursorMode: TCursorMode;
  413.     FOptions: TClipFormOptions;
  414.     FPopupBorderStyle: TPopupBorderStyle;
  415.     FBorderSize: integer;
  416.     FMargins: TRect;
  417.     procedure SetPopupBorderStyle(Value: TPopupBorderStyle);
  418.     procedure BeginMoving(XCursor, YCursor, Delta: integer);
  419.     procedure SetOptions(const Value: TClipFormOptions);
  420.   protected
  421.     procedure RedrawBorder; virtual;
  422.     procedure DrawHeader; virtual;
  423.     procedure DrawFooter; virtual;
  424.     procedure SetMargins; virtual;
  425.     procedure InvalidateButtons; virtual;
  426.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  427.     procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
  428.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  429.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  430.     procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
  431.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  432.     procedure WMActivate (var Message: TWMActivate); message WM_ACTIVATE;
  433.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  434.     procedure CMSetAlignment(var Message: TMessage); message CM_SETALIGNMENT;
  435.     procedure CreateWnd; override;
  436.   public
  437.     constructor Create(AOwner: TComponent); override;
  438.     destructor Destroy; override;
  439.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  440.     procedure Show; override;
  441.     procedure Hide; override;
  442.     property Buttons: TDCEditButtons read FButtons;
  443.     property Options: TClipFormOptions read FOptions write SetOptions;
  444.     property PopupBorderStyle: TPopupBorderStyle read FPopupBorderStyle write SetPopupBorderStyle;
  445.     property Margins: TRect read FMargins;
  446.     property BorderSize: integer read FBorderSize;
  447.     property Caption;
  448.     property Color;
  449.     property Font;
  450.   end;
  451.  
  452.   TDBClipPopup = class(TDCClipPopup)
  453.   private
  454.     FHintHeight: integer;
  455.     FLinesCount: integer;
  456.     FMaxPos: integer;
  457.     FOnButtonClick: TNotifyEvent;
  458.     FPopupStyle: TClipPopupStyle;
  459.     FUpdateCount: integer;
  460.     function GetActiveButton: TDCEditButton;
  461.     procedure SetPopupStyle(const Value: TClipPopupStyle);
  462.   protected
  463.     procedure AdjustClipSize; dynamic;
  464.     procedure BeginUpdate;
  465.     procedure ButtonClick(Sender: TObject); virtual;
  466.     procedure DrawButtonHint(Sender: TObject; Mode: integer); virtual;
  467.     procedure EndUpdate;
  468.     procedure RedrawBorder; override;
  469.   public
  470.     constructor Create(AOwner: TComponent); override;
  471.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  472.     procedure Clear;
  473.     function AddButton(AName, AResource, AHint: string; ALine,
  474.       APos: integer): TDCEditButton;
  475.     procedure AddButtons; virtual;
  476.     property ActiveButton: TDCEditButton read GetActiveButton;
  477.     property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
  478.     property PopupStyle: TClipPopupStyle read FPopupStyle write SetPopupStyle;
  479.     property UpdateCount: integer read FUpdateCount;
  480.   end;
  481.  
  482. procedure ProcessMovingWindow(Sender: TWinControl; XCursor, YCursor: integer;
  483.   CursorMode: TCursorMode; ItemHeight: integer);
  484.  
  485. function ShowWindow(Handle: HWND; Alignment: TWindowAlignment;
  486.    WindowBounds: TRect; AlwaysVisible: boolean; Parent: TControl = nil): integer;
  487. procedure HideWindow(Handle: HWND);
  488.  
  489. var
  490.   DropDownMoving: boolean;
  491.  
  492. implementation
  493.  
  494. uses
  495.   DCResource, DCChoice, TypInfo, DCGrids;
  496.  
  497. const
  498.   SLLTIMER_IDEVENT = SRCTIMER_IDEVENT + $1;
  499.  
  500. type
  501.   TPrivateControl = class(TControl)
  502.   end;
  503.  
  504.   TPrivateDBGrid = class(TDCDBGrid)
  505.   end;
  506.  
  507.   TPrivateDataSet = class(TDataSet)
  508.   end;
  509.  
  510. { TDCPopupWindow }
  511.  
  512. function ShowWindow(Handle: HWND; Alignment: TWindowAlignment;
  513.    WindowBounds: TRect; AlwaysVisible: boolean; Parent: TControl = nil): integer;
  514.  var
  515.   P: TPoint;
  516.   AHeight, AWidth: integer;
  517.   ZOrder: THandle;
  518. begin
  519.   Result  := 0;
  520.   AHeight :=  WindowBounds.Bottom - WindowBounds.Top;
  521.   AWidth  :=  WindowBounds.Right  - WindowBounds.Left;
  522.   if Parent <> nil then
  523.   begin
  524.     case Alignment of
  525.       wpNone       :
  526.         begin
  527.           Result  := -1;
  528.           P := Point(WindowBounds.Left, WindowBounds.Top);
  529.           //if AlwaysVisible then SetRectInDesktop(P, AWidth, AHeight, Point(0,0));
  530.         end;
  531.       wpBottomLeft :
  532.         begin
  533.           P := Point((Parent.ClientWidth-Parent.Width) div 2,
  534.                      Parent.ClientHeight + (Parent.Height-Parent.ClientHeight) shr 1);
  535.           P := Parent.ClientToScreen(P);
  536.           if AlwaysVisible then
  537.             Result := SetRectInDesktop(P, AWidth, AHeight,
  538.               Point(0,(Screen.DesktopTop+Screen.DesktopHeight)-P.Y+Parent.Height));
  539.         end;
  540.       wpBottomRight:
  541.         begin
  542.           P := Point(Parent.ClientWidth  + (Parent.Width-Parent.ClientWidth) div 2,
  543.                      Parent.ClientHeight + (Parent.Height-Parent.ClientHeight) shr 1);
  544.           P := Parent.ClientToScreen(P);
  545.           P.X := P.X - AWidth;
  546.           if AlwaysVisible then
  547.             Result := SetRectInDesktop(P, AWidth, AHeight,
  548.               Point(0,(Screen.DesktopTop+Screen.DesktopHeight)-P.Y+Parent.Height));
  549.         end;
  550.       wpTopRight   :
  551.         begin
  552.           P := Point(Parent.ClientWidth, -((Parent.Height-Parent.ClientHeight) shr 1));
  553.           P := Parent.ClientToScreen(P);
  554.           if AlwaysVisible then
  555.             Result := SetRectInDesktop(P, AWidth, AHeight,
  556.               Point((Screen.DesktopLeft+Screen.DesktopWidth)-P.X+Parent.ClientWidth+
  557.               (Parent.Width-Parent.ClientWidth) shr 1,0));
  558.         end;
  559.       wpOffset     :
  560.         begin
  561.           P := Point(WindowBounds.Left, WindowBounds.Top);
  562.           P := Parent.ClientToScreen(P);
  563.           if AlwaysVisible then
  564.             Result := SetRectInDesktop(P, AWidth, AHeight, Point(0,0));
  565.         end;
  566.     end;
  567.   end
  568.   else begin
  569.     Result  := -1;
  570.     P := Point(WindowBounds.Left, WindowBounds.Top);
  571.     if AlwaysVisible then
  572.     begin
  573.       if P.Y < 0 then P.Y := 0;
  574.       if (P.Y + AHeight) > Screen.Height then
  575.       begin
  576.         P.Y := Screen.Height - AHeight;
  577.       end;
  578.       if P.X < 0 then P.X := 0;
  579.       if (P.X + AWidth) > Screen.Width then
  580.       begin
  581.         P.X := Screen.Width - AWidth;
  582.       end;
  583.     end;
  584.   end;
  585.  
  586.   ZOrder := HWND_TOPMOST;
  587.   SetWindowPos(Handle, ZOrder, P.X, P.Y, 0, 0,
  588.     SWP_NOSIZE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_SHOWWINDOW);
  589.   BringWindowToTop(Handle);
  590. end;
  591.  
  592. procedure HideWindow(Handle: HWND);
  593. begin
  594.   SetWindowPos(Handle, 0, 0, 0, 0, 0,
  595.     SWP_NOZORDER + SWP_NOMOVE + SWP_NOSIZE + SWP_NOACTIVATE + SWP_HIDEWINDOW);
  596. end;
  597.  
  598. procedure ProcessMovingWindow(Sender: TWinControl; XCursor, YCursor: integer;
  599.   CursorMode: TCursorMode; ItemHeight: integer);
  600.  var
  601.   ScreenDC: HDC;
  602.   Accept: boolean;
  603.   Msg: TMsg;
  604.   MousePoint: TPoint;
  605.   NextRect, LastRect: TRect;
  606.   AItemHeight,ADelta: integer;
  607.   InfoWindow: TDCMessageWindow;
  608.   ScreenBitmap: TBitmap;
  609.  
  610.  procedure UpdateInfoWindow;
  611.   var
  612.    ScreenDC: HDC;
  613.  begin
  614.    with InfoWindow do
  615.    begin
  616.      Left := LastRect.Left + 4;
  617.      Top  := LastRect.Top  + 4;
  618.      case CursorMode of
  619.        cmMove:
  620.          Caption := Format('%d, %d', [LastRect.Left, LastRect.Top]);
  621.        cmResize:
  622.          Caption := Format('%d x %d',
  623.            [(LastRect.Right - LastRect.Left), (LastRect.Bottom - LastRect.Top)]);
  624.      end;
  625.       ProcessPaintMessages;
  626.       ScreenDC := GetDC(0);
  627.       try
  628.         ScreenBitmap.Width  := Width;
  629.         ScreenBitmap.Height := Height;
  630.         BitBlt(ScreenBitmap.Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left+1, Top+1, SRCCOPY);
  631.       finally
  632.         ReleaseDC(0, ScreenDC);
  633.       end;
  634.       //Show;
  635.    end
  636.  end;
  637.  
  638.  procedure HideInfoWindow;
  639.   var
  640.    ScreenDC: HDC;
  641.  begin
  642.    with InfoWindow do
  643.    begin
  644.      //Hide;
  645.      ScreenDC := GetDC(0);
  646.      try
  647.        BitBlt(ScreenDC, Left+1, Top+1, Width, Height, ScreenBitmap.Canvas.Handle, 0, 0, SRCCOPY);
  648.      finally
  649.        ReleaseDC(0, ScreenDC);
  650.      end;
  651.    end
  652.  end;
  653.  
  654.  procedure MouseMoved;
  655.   var
  656.    Value,Pos: TPoint;
  657.  begin
  658.  
  659.    GetCursorPos(Pos);
  660.    Value := Pos;
  661.  
  662.    {Γ√≈Φ±δ σ∞ ε≥δΦ≈Φσ}
  663.    Pos.X := Pos.X - MousePoint.X;
  664.    Pos.Y := Pos.Y - MousePoint.Y;
  665.    NextRect   := LastRect;
  666.  
  667.    case CursorMode of
  668.      cmResize: {Resize Window}
  669.       begin
  670.         NextRect.Right  := NextRect.Right  + Pos.X;
  671.         if Abs(ADelta) >= (ItemHeight shr 1) then
  672.         begin
  673.           if Abs(ADelta) > ItemHeight then
  674.             AItemHeight := (ADelta div ItemHeight)*ItemHeight
  675.           else
  676.             AItemHeight := (ADelta div Abs(ADelta))*ItemHeight;
  677.           NextRect.Bottom := NextRect.Bottom + AItemHeight;
  678.           Value.Y := NextRect.Bottom;
  679.           ADelta  := 0;
  680.           SetCursorPos(Value.X, Value.Y);
  681.         end
  682.         else
  683.           ADelta := ADelta + Pos.Y;
  684.       end;
  685.      cmMove  : {Move Window}
  686.       OffsetRect(NextRect, Pos.X, Pos.Y);
  687.    end;
  688.  
  689.    if not EqualRect(NextRect, LastRect) then
  690.    begin
  691.      HideInfoWindow;
  692.      DrawFocusedRect(ScreenDC, @LastRect, @NextRect, 2);
  693.      LastRect := NextRect;
  694.      UpdateInfoWindow;
  695.    end;
  696.  
  697.    MousePoint := Value;
  698.  
  699.  end;
  700.  
  701.  procedure Dropped;
  702.   var
  703.    Value: integer;
  704.  begin
  705.    Sender.Perform(CM_SETALIGNMENT, Integer(wpNone), 0);
  706.    if LastRect.Left > LastRect.Right then
  707.    begin
  708.      Value := LastRect.Left;
  709.      LastRect.Left  := LastRect.Right;
  710.      LastRect.Right := Value;
  711.    end;
  712.    if LastRect.Top > LastRect.Bottom then
  713.    begin
  714.      Value := LastRect.Top;
  715.      LastRect.Top   := LastRect.Bottom;
  716.      LastRect.Bottom:= Value;
  717.    end;
  718.  
  719.    Sender.SetBounds(LastRect.Left, LastRect.Top,
  720.       LastRect.Right-LastRect.Left, LastRect.Bottom-LastRect.Top);
  721.  
  722.  end;
  723. begin
  724.   Accept := False;
  725.   ADelta := 0;
  726.   MousePoint := Point(XCursor, YCursor);
  727.   with Sender do
  728.   begin
  729.     LastRect   := Rect(Left, Top, Left+Width, Top+Height);
  730.  
  731.     ProcessPaintMessages;
  732.  
  733.     {┴δεΩΦ≡σ∞ ∩σ≡σ≡Φ±εΓΩ≤ Σ≡≤πΦ⌡ εΩεφ, ∩≡Φ Φτ∞σφσφΦΦ ∩ετΦ÷ΦΦ εΩφα}
  734.     //LockWindowUpdate(GetDesktopWindow);
  735.     LockWindowUpdate(Parent.Handle);
  736.  
  737.     ScreenDC := GetDCEx(GetDesktopWindow, 0,
  738.       DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW);
  739.  
  740.     InfoWindow  := TDCMessageWindow.Create(nil);
  741.     ScreenBitmap := TBitmap.Create;
  742.  
  743.     with InfoWindow do
  744.     begin
  745.       AutoHide := False;
  746.       Parent   := Sender;
  747.       PopupAlignment := wpOffset;
  748.     end;
  749.  
  750.     try
  751.       SetCapture(Handle);
  752.       DrawFocusedRect(ScreenDC, nil, @LastRect, 2);
  753.       UpdateInfoWindow;
  754.  
  755.       DropDownMoving := True;
  756.       while GetCapture = Handle do begin
  757.         case Integer(GetMessage(Msg, 0, 0, 0)) of
  758.           -1: Break;
  759.           0 :
  760.            begin
  761.              PostQuitMessage(Msg.WParam);
  762.              Break;
  763.            end;
  764.         end;
  765.  
  766.         case Msg.Message of
  767.           WM_KEYDOWN, WM_KEYUP:
  768.             case Msg.WParam of
  769.               VK_ESCAPE:Break;
  770.             end;
  771.           WM_MOUSEMOVE:
  772.             MouseMoved;
  773.           WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  774.             Break;
  775.           WM_LBUTTONUP:
  776.             begin
  777.               Accept := True;
  778.               Break;
  779.             end;
  780.           WM_RBUTTONDOWN..WM_MBUTTONDBLCLK:;
  781.           else begin
  782.             TranslateMessage(Msg);
  783.             DispatchMessage(Msg);
  784.           end;
  785.         end;
  786.       end;
  787.  
  788.     finally
  789.       if GetCapture = Handle then ReleaseCapture;
  790.  
  791.       { Hide dragging outline and release the DC }
  792.       DrawFocusedRect(ScreenDC, nil, @LastRect, 2);
  793.       ReleaseDC(GetDesktopWindow, ScreenDC);
  794.  
  795.       LockWindowUpdate(0);
  796.       InfoWindow.Free;
  797.       ScreenBitmap.Free;
  798.       DropDownMoving := False;
  799.     end;
  800.   end;
  801.  
  802.   if Accept then Dropped;
  803. end;
  804.  
  805. procedure TDCPopupWindow.CMShowingChanged(var Message: TMessage);
  806.  var
  807.   AOrientation: integer;
  808. begin
  809.   AOrientation := ShowWindow(Handle, FPopupAlignment, FWindowRect,
  810.     FAlwaysVisible, Owner);
  811.   if AOrientation <> -1 then Orientation := AOrientation;
  812. end;
  813.  
  814. constructor TDCPopupWindow.Create(AOwner: TComponent);
  815. begin
  816.   inherited Create(AOwner);
  817.   FVisible := False;
  818.   ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable,
  819.     csAcceptsControls, csOpaque];
  820.  
  821.   Visible := False;
  822.   Canvas.Brush.Style := bsClear;
  823.   FAlwaysVisible := True;
  824.   FOwner := TControl(AOwner);
  825.   SetRectEmpty(FWindowRect);
  826. end;
  827.  
  828.  
  829. procedure TDCPopupWindow.CreateParams(var Params: TCreateParams);
  830. begin
  831.   inherited CreateParams(Params);
  832.   with Params do
  833.   begin
  834.     ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
  835.     WindowClass.Style := CS_SAVEBITS;
  836.     AddBiDiModeExStyle(ExStyle);
  837.   end;
  838. end;
  839.  
  840. procedure TDCPopupWindow.CreateWnd;
  841. begin
  842.   inherited CreateWnd;
  843.   if HandleAllocated then
  844.   begin
  845.     Windows.SetParent(Handle, 0);
  846.     CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
  847.   end;
  848. end;
  849.  
  850. destructor TDCPopupWindow.Destroy;
  851. begin
  852.   inherited;
  853. end;
  854.  
  855. function TDCPopupWindow.GetTextHeight(Value: string): integer;
  856.  var
  857.   R: TSize;
  858. begin
  859.   Windows.GetTextExtentPoint(Canvas.Handle, PChar(Value), Length(Value), R);
  860.   Result := R.CY;
  861. end;
  862.  
  863. function TDCPopupWindow.GetTextWidth(Value: string): integer;
  864.  var
  865.   R: TSize;
  866. begin
  867.   Windows.GetTextExtentPoint(Canvas.Handle, PChar(Value), Length(Value), R);
  868.   Result := R.CX;
  869. end;
  870.  
  871. procedure TDCPopupWindow.Hide;
  872. begin
  873.   HideWindow(Handle);
  874.   FVisible := False;
  875. end;
  876.  
  877. procedure TDCPopupWindow.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  878. begin
  879.   inherited;
  880.   FWindowRect := Rect(Left, Top, Left + Width, Top + Height);
  881. end;
  882.  
  883. procedure TDCPopupWindow.SetBoundsEx(ALeft, ATop, AWidth,
  884.   AHeight: Integer);
  885. begin
  886.   FWindowRect := Rect(ALeft,ATop,ALeft+AWidth,aTop+AHeight);
  887.   if FVisible then Show;
  888. end;
  889.  
  890. procedure TDCPopupWindow.SetOrientation(const Value: integer);
  891. begin
  892.   FOrientation := Value;
  893. end;
  894.  
  895. procedure TDCPopupWindow.SetPopupAlignment(Value: TWindowAlignment);
  896. begin
  897.   if Value <> FPopupAlignment then
  898.   begin
  899.     FPopupAlignment := Value;
  900.     if Visible then Show;
  901.   end;
  902. end;
  903.  
  904. procedure TDCPopupWindow.Show;
  905.  var
  906.   AOrientation: integer;
  907. begin
  908.   AOrientation := ShowWindow(Handle, FPopupAlignment, FWindowRect,
  909.     FAlwaysVisible, Owner);
  910.   if AOrientation <> -1 then Orientation := AOrientation;
  911.   FVisible :=  True;
  912. end;
  913.  
  914. procedure TDCPopupWindow.WMMouseActivate(var Message: TWMActivate);
  915. begin
  916.   inherited;
  917.   Message.Result := MA_NOACTIVATE;
  918.   SetWindowPos (Handle, HWND_TOP, 0, 0, 0, 0,
  919.      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  920. end;
  921.  
  922. procedure TDCPopupWindow.WMNCCalcSize(var Message: TWMNCCalcSize);
  923. begin
  924.   inherited;
  925. end;
  926.  
  927. procedure TDCPopupWindow.WMNCPaint(var Message: TWMNCPaint);
  928. begin
  929.   {}
  930. end;
  931.  
  932. { TDCPopupListBox }
  933.  
  934. constructor TDCPopupListBox.Create(AOwner: TComponent);
  935. begin
  936.   inherited Create(AOwner);
  937.   FVisible    := False;
  938.   ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable,
  939.                                   csAcceptsControls];
  940.  
  941.   Visible := False;
  942.   
  943.   Canvas.Brush.Style := bsClear;
  944.   FAlwaysVisible := True;
  945.   FOwner := TControl(AOwner);
  946.   SetRectEmpty(FWindowRect);
  947.   Style := lbOwnerDrawVariable;
  948.   FDropDownRows := 8;
  949.   AdjustNewHeight;
  950. end;
  951.  
  952. procedure TDCPopupListBox.CreateParams(var Params: TCreateParams);
  953. begin
  954.   inherited CreateParams(Params);
  955.   with Params do
  956.   begin
  957.     ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
  958.     AddBiDiModeExStyle(ExStyle);
  959.     WindowClass.Style := CS_SAVEBITS;
  960.   end;
  961. end;
  962.  
  963. procedure TDCPopupListBox.CreateWnd;
  964. begin
  965.   inherited CreateWnd;
  966.   if Parent <> nil then
  967.   begin
  968.     Windows.SetParent(Handle, 0);
  969.     CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
  970.   end;  
  971. end;
  972.  
  973. procedure TDCPopupListBox.Hide;
  974. begin
  975.   HideWindow(Handle);
  976.   FVisible := False;
  977. end;
  978.  
  979. procedure TDCPopupListBox.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  980. begin
  981.   inherited;
  982.   FWindowRect := Rect(Left,Top,Left+Width,Top+Height);
  983. end;
  984.  
  985. procedure TDCPopupListBox.SetBoundsEx(ALeft, ATop, AWidth,
  986.   AHeight: Integer);
  987. begin
  988.   FWindowRect := Rect(ALeft,ATop,ALeft+AWidth,aTop+AHeight);
  989.   if FVisible then Show;
  990. end;
  991.  
  992. procedure TDCPopupListBox.SetPopupAlignment(Value: TWindowAlignment);
  993. begin
  994.   if Value <> FPopupAlignment then
  995.   begin
  996.     FPopupAlignment := Value;
  997.     if Visible then Show;
  998.   end;
  999. end;
  1000.  
  1001. procedure TDCPopupListBox.Show;
  1002. begin
  1003.   SetListHeight(0);
  1004.   ShowWindow(Handle, FPopupAlignment, FWindowRect, FAlwaysVisible, Owner);
  1005.   FVisible :=  True;
  1006. end;
  1007.  
  1008. procedure TDCPopupListBox.WMMouseActivate(var Message: TWMActivate);
  1009. begin
  1010.   inherited;
  1011.   Message.Result := MA_NOACTIVATE;
  1012.   SetWindowPos (Handle, HWND_TOP, 0, 0, 0, 0,
  1013.      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  1014. end;
  1015.  
  1016. procedure TDCPopupListBox.WMNCCalcSize(var Message: TWMNCCalcSize);
  1017. begin
  1018.   inherited;
  1019.   case FPopupBorderStyle of
  1020.     brNone  :;
  1021.     brSingle:
  1022.       begin
  1023.         InflateRect(Message.CalcSize_Params^.rgrc[0], -1, -1);
  1024.       end;
  1025.     brRaised:
  1026.       begin
  1027.         InflateRect(Message.CalcSize_Params^.rgrc[0], -2, -2);
  1028.       end;
  1029.   end;
  1030. end;
  1031.  
  1032. procedure TDCPopupListBox.SetPopupBorderStyle(Value: TPopupBorderStyle);
  1033. begin
  1034.   if FPopupBorderStyle <> Value then
  1035.   begin
  1036.     FPopupBorderStyle := Value;
  1037.     case FPopupBorderStyle of
  1038.       brNone  :FBorderSize := 0;
  1039.       brSingle:FBorderSize := 1;
  1040.       brRaised:FBorderSize := 2;
  1041.     end;
  1042.     RecreateWnd;
  1043.   end;
  1044. end;
  1045.  
  1046. procedure TDCPopupListBox.WMNCPaint(var Message: TWMNCPaint);
  1047. begin
  1048.   inherited;
  1049.   RedrawBorder;
  1050. end;
  1051.  
  1052. procedure TDCPopupListBox.RedrawBorder;
  1053.  var
  1054.   DC: HDC;
  1055.   R: TRect;
  1056.   ABrush: HBRUSH;
  1057. begin
  1058.   DC := GetWindowDC(Handle);
  1059.   try
  1060.     GetWindowRect(Handle, R);  OffsetRect(R, -R.Left, -R.Top);
  1061.     case FPopupBorderStyle of
  1062.       brNone:;
  1063.       brSingle:
  1064.         begin 
  1065.           ABrush :=  CreateSolidBrush(clBlack);
  1066.           FrameRect( DC, R, ABrush);
  1067.           DeleteObject(ABrush);
  1068.         end;
  1069.       brRaised:
  1070.         begin
  1071.           DrawEdge(DC, R, BDR_RAISEDOUTER, BF_RECT);
  1072.           InflateRect(R, -1, -1);
  1073.           DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT);
  1074.         end;
  1075.     end;
  1076.   finally
  1077.     ReleaseDC(Handle, DC);
  1078.   end;
  1079. end;
  1080.  
  1081. procedure TDCPopupListBox.CNDrawItem(var Message: TWMDrawItem);
  1082. var
  1083.   State: TOwnerDrawState;
  1084. begin
  1085.   with Message.DrawItemStruct^ do
  1086.   begin
  1087.     {$IFDEF DELPHI_V5UP}
  1088.        State := TOwnerDrawState(LongRec(itemState).Lo);
  1089.     {$ELSE}
  1090.        State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
  1091.     {$ENDIF}
  1092.     Canvas.Lock;
  1093.     try
  1094.       Canvas.Handle := hDC;
  1095.       Canvas.Font := Font;
  1096.       Canvas.Brush := Brush;
  1097.       if (Integer(itemID) >= 0) and (odSelected in State) then
  1098.       begin
  1099.         Canvas.Brush.Color := clHighlight;
  1100.         Canvas.Font.Color := clHighlightText
  1101.       end;
  1102.       if Integer(itemID) >= 0 then
  1103.         DrawItem(itemID, rcItem, State) else
  1104.         Canvas.FillRect(rcItem);
  1105.     finally
  1106.       Canvas.Handle := 0;
  1107.       Canvas.Unlock;
  1108.     end;
  1109.   end;
  1110.  
  1111. end;
  1112.  
  1113. procedure TDCPopupListBox.WMMouseMove(var Message: TWMMouseMove);
  1114.  var
  1115.   ItemPos: integer;
  1116. begin
  1117.   inherited;
  1118.   with Message do
  1119.     ItemPos := ItemAtPos(Point(XPos,YPos), True);
  1120.   if ItemPos <> -1 then begin
  1121.     ItemIndex := ItemPos;
  1122.   end;
  1123. end;
  1124.  
  1125. procedure TDCPopupListBox.WMFontChange(var Message: TWMFontChange);
  1126. begin
  1127.   inherited;
  1128.   AdjustNewHeight;
  1129. end;
  1130.  
  1131. procedure TDCPopupListBox.AdjustNewHeight;
  1132. var
  1133.   DC: HDC;
  1134.   SaveFont: HFONT;
  1135.   Metrics: TTextMetric;
  1136. begin
  1137.   DC := GetDC(0);
  1138.   SaveFont := SelectObject(DC, Font.Handle);
  1139.   try
  1140.     GetTextMetrics(DC, Metrics);
  1141.     ItemHeight := Metrics.tmHeight + 3;
  1142.   finally
  1143.     SelectObject(DC, SaveFont);
  1144.     ReleaseDC(0, DC);
  1145.   end;
  1146. end;
  1147.  
  1148. procedure TDCPopupListBox.SetListHeight(Increment: integer);
  1149.  var
  1150.   ItemsCount: integer;
  1151.   AWindowRect: TRect;
  1152. begin
  1153.   AWindowRect := FWindowRect;
  1154.   if Items.Count < FDropDownRows then
  1155.    ItemsCount := Items.Count+Increment
  1156.   else
  1157.    ItemsCount := Items.Count;
  1158.  
  1159.   if ItemsCount > 0 then
  1160.   begin
  1161.     if ItemsCount > FDropDownRows then
  1162.        Height := ItemHeight*FDropDownRows + 2*FBorderSize
  1163.     else
  1164.        Height := ItemHeight*ItemsCount + 2*FBorderSize
  1165.   end
  1166.   else
  1167.     Height := ItemHeight + 2*FBorderSize;
  1168.  
  1169.   AWindowRect.Bottom := FWindowRect.Bottom - FWindowRect.Top + AWindowRect.Top;
  1170.   FWindowRect := AWindowRect;
  1171. end;
  1172.  
  1173. function TDCPopupListBox.DoMouseWheel(Shift: TShiftState;
  1174.   WheelDelta: Integer; MousePos: TPoint): Boolean;
  1175.  var
  1176.   ATopIndex: integer;
  1177. begin
  1178.   Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  1179.   if not Result then
  1180.   begin
  1181.     ATopIndex := TopIndex - (WheelDelta div WHEEL_DELTA);
  1182.     if (ATopIndex >= 0) and (ATopIndex + DropDownRows <= Items.Count) then
  1183.       TopIndex := ATopIndex;
  1184.     Result := True
  1185.   end;
  1186. end;
  1187.  
  1188. { TDCMessageWindow }
  1189.  
  1190. procedure TDCMessageWindow.CreateParams(var Params: TCreateParams);
  1191. begin
  1192.   inherited;
  1193. end;
  1194.  
  1195. procedure TDCMessageWindow.WMNCHitTest(var Message: TWMNCHitTest);
  1196. begin
  1197.   inherited;
  1198.   if FButtons.Count = 0 then Message.Result := HTTRANSPARENT;
  1199. end;
  1200.  
  1201. procedure TDCMessageWindow.Paint;
  1202.  var
  1203.   R: TRect;
  1204.   OffsetX, OffsetY: integer;
  1205.   FImageRgn: HRGN;
  1206.   P: TPoint;
  1207.   ADefault: boolean;
  1208.   AText: string;
  1209. begin
  1210.   R := ClientRect;
  1211.  
  1212.   FImage.Width  := R.Right - R.Left;
  1213.   FImage.Height := R.Bottom - R.Top;
  1214.   FImageRgn := GetRegion;
  1215.  
  1216.   try
  1217.     with FImage do
  1218.     begin
  1219.       Canvas.Brush.Color := Color;
  1220.       Canvas.Font := Self.Font;
  1221.       case FMessageStyle of
  1222.         msNormal:
  1223.           begin
  1224.             Canvas.FillRect(R);
  1225.             DrawEdge(Canvas.Handle, R, BDR_SUNKENOUTER, BF_TOPLEFT);
  1226.             DrawEdge(Canvas.Handle, R, BDR_RAISEDOUTER, BF_BOTTOMRIGHT);
  1227.           end;
  1228.         msRoundRect, msTail:
  1229.           begin
  1230.             Canvas.Brush.Color := Color;
  1231.             PaintRgn(FImage.Canvas.Handle, FImageRgn);
  1232.             Canvas.Brush.Color := clBtnShadow;
  1233.             FrameRgn(FImage.Canvas.Handle, FImageRgn, FImage.Canvas.Brush.Handle, 1, 1);
  1234.           end;
  1235.       end;
  1236.  
  1237.       Canvas.Font.Color  := clInfoText;
  1238.  
  1239.       OffsetX := 0;
  1240.       OffsetY := 0;
  1241.       case FMessageStyle of
  1242.         msNormal:
  1243.           begin
  1244.             OffsetX := FMargins.Left;
  1245.             OffsetY := FMargins.Top;
  1246.           end;
  1247.         msRoundRect:
  1248.           begin
  1249.            OffsetX := FRoundValue-3 + FMargins.Left div 2;
  1250.            OffsetY := FRoundValue-3 + FMargins.Top div 2;
  1251.           end;
  1252.         msTail:
  1253.           begin
  1254.            OffsetX := FRoundValue-3 + FMargins.Left div 2;
  1255.            OffsetY := FRoundValue-3 + FMargins.Top div 2;
  1256.            case FOrientation of
  1257.              0: OffsetY := OffsetY + FTailValue;
  1258.              2: OffsetY := OffsetY + FTailValue;
  1259.              4: OffsetY := OffsetY + FTailValue;
  1260.            end;
  1261.           end;
  1262.       end;
  1263.  
  1264.       R.Left := R.Left + OffsetX;
  1265.       R.Top  := R.Top  + OffsetY;
  1266.       if FBitmapVisible and Assigned(FBitmap) then
  1267.       begin
  1268.          DrawBitmap(Canvas, FBitmap, R, False);
  1269.          OffsetX := OffsetX + FBitmap.Width + FBitmapOffset;
  1270.       end;
  1271.      ADefault := True;
  1272.      R := Rect(OffsetX, OffsetY, Width, Height);
  1273.      AText := Text;
  1274.      if Assigned(FOnDrawInfoText) then FOnDrawInfoText(Self, Canvas.Handle, R, AText, ADefault);
  1275.  
  1276.      if ADefault then
  1277.      begin
  1278.        if Centered then
  1279.         begin
  1280.           P := DrawHighLightText(Canvas, PChar(AText), R, 0, DT_WORDBREAK);
  1281.           if P.Y < Height - OffsetY then OffsetY  := (Height + OffsetY - P.Y) shr 1;
  1282.           R := Rect(OffsetX, OffsetY, Width, Height);
  1283.           DrawHighLightText(Canvas, PChar(AText), R, 1, DT_WORDBREAK or DT_END_ELLIPSIS);
  1284.         end
  1285.         else
  1286.           DrawHighLightText(Canvas, PChar(AText), R, 1, DT_WORDBREAK or DT_END_ELLIPSIS);
  1287.       end;
  1288.     end;
  1289.     Canvas.Draw(0, 0, FImage);
  1290.   finally
  1291.     DeleteObject(FImageRgn);
  1292.   end;
  1293. end;
  1294.  
  1295. procedure TDCMessageWindow.SetDialogStyle(Value: TDialogStyle);
  1296. begin
  1297.   if Value <> FDialogStyle then
  1298.   begin
  1299.     FDialogStyle   := Value;
  1300.     FBitmapVisible := True;
  1301.     if FUpdateCount = 0 then AdjustWindowSize;
  1302.   end;
  1303. end;
  1304.  
  1305. procedure TDCMessageWindow.AdjustWindowSize;
  1306.  var
  1307.   P: TPoint;
  1308.   R: TRect;
  1309.   i, OffsetX: integer;
  1310. begin
  1311.   if AutoSize then
  1312.   begin
  1313.     P := DrawHighLightText(Canvas, PChar(Text), Rect(0, 0, Width, Height), 0);
  1314.     if FButtons.Count > 0 then
  1315.     begin
  1316.       R := FButtons.GetButtonsRect;
  1317.       OffsetRect(R, -R.Left, -R.Top);
  1318.       P.Y := P.Y + R.Bottom + 5;
  1319.       if P.X < R.Right then P.X := R.Right;
  1320.     end;
  1321.  
  1322.     if (FMaxTextWidth > 0) and (P.X > FMaxTextWidth) then
  1323.     begin
  1324.       OffsetX := P.X - FMaxTextWidth;
  1325.       for i := 0 to FButtons.Count-1 do
  1326.         FButtons.Buttons[i].Left := FButtons.Buttons[i].Left - OffsetX;
  1327.       P := DrawHighLightText(Canvas, PChar(Text), Rect(0, 0, FMaxTextWidth, 500),
  1328.         0, DT_LEFT or DT_WORDBREAK);
  1329.       if FButtons.Count > 0 then
  1330.       begin
  1331.         R := FButtons.GetButtonsRect;
  1332.         OffsetRect(R, -R.Left, -R.Top);
  1333.         P.Y := P.Y + R.Bottom + 5;
  1334.       end;
  1335.     end;
  1336.  
  1337.     case FDialogStyle of
  1338.       dsSimple:
  1339.          begin
  1340.            Color := clMessageWindow;
  1341.            FBitmapVisible := False;
  1342.            Width  := P.X + FMargins.Left + FMargins.Right;
  1343.            Height := P.Y + FMargins.Top  + FMargins.Bottom;
  1344.          end;
  1345.       dsInvalidValue:
  1346.          begin
  1347.            Color := clMessageWindow;
  1348.            FBitmap.LoadFromResourceName(HInstance, 'DC_MV_INVALIDVALUE');
  1349.            if FBitmapVisible then
  1350.            begin
  1351.              Width  := P.X + FMargins.Left + FMargins.Right + FBitmap.Width + FBitmapOffset;
  1352.              Height := _intMax(P.Y, FBitmap.Height) + FMargins.Top + FMargins.Bottom;
  1353.            end
  1354.            else begin
  1355.              Width  := P.X + FMargins.Left + FMargins.Right;
  1356.              Height := P.Y + FMargins.Top  + FMargins.Bottom;
  1357.            end;
  1358.          end;
  1359.       dsCustom      :
  1360.          begin
  1361.            if FBitmapVisible then
  1362.            begin
  1363.              Width  := P.X + FMargins.Left + FMargins.Right + FBitmap.Width + FBitmapOffset;
  1364.              Height := _intMax(P.Y, FBitmap.Height) + FMargins.Top + FMargins.Bottom;
  1365.            end
  1366.            else begin
  1367.              Width  := P.X + FMargins.Left + FMargins.Right;
  1368.              Height := P.Y + FMargins.Top + FMargins.Bottom;
  1369.            end;
  1370.          end;
  1371.     end;
  1372.     case FMessageStyle of
  1373.       msNormal:
  1374.         begin
  1375.           Width  := Width  + 2;
  1376.           Height := Height + 2;
  1377.         end;
  1378.       msRoundRect:
  1379.         begin
  1380.           Width  := Width  + 2*(FRoundValue-3);
  1381.           Height := Height + 2*(FRoundValue-3);
  1382.         end;
  1383.       msTail:
  1384.         begin
  1385.           Width  := Width  + 2*(FRoundValue-3);
  1386.           Height := Height + 2*(FRoundValue-3) + FTailValue;
  1387.         end;
  1388.     end;
  1389.   end;
  1390. end;
  1391.  
  1392. constructor TDCMessageWindow.Create(AOwner: TComponent);
  1393. begin
  1394.   inherited;
  1395.   FImage  := TBitmap.Create;
  1396.   FBitmap := TBitmap.Create;
  1397.   Canvas.Brush.Style := bsClear;
  1398.   FDialogStyle := dsSimple;
  1399.   FBitmapVisible := True;
  1400.  
  1401.   FButtons := TDCEditButtons.Create(Self);
  1402.   FButtons.AnchorStyle := asNone;
  1403.   FButtons.Color := clBtnFace;
  1404.   SetMargins;
  1405.  
  1406.   FAutoHide := False;
  1407.   FAutoSize := True;
  1408.   FTimeOut  := 2000;
  1409.  
  1410.   FBitmapOffset := 6;
  1411.   FRoundValue   := 7;
  1412.   FTailValue    := 8;
  1413.  
  1414.   FMessageStyle := msNormal;
  1415.   FMaxTextWidth := 0;
  1416. end;
  1417.  
  1418. destructor TDCMessageWindow.Destroy;
  1419. begin
  1420.   StopTimer;
  1421.   FImage.Free;
  1422.   FButtons.Free;
  1423.   FButtons := nil;
  1424.   FBitmap.Free;
  1425.   inherited;
  1426. end;
  1427.  
  1428. procedure TDCMessageWindow.CreateWnd;
  1429. begin
  1430.   inherited;
  1431.   if Parent <> nil then FButtons.SetWndProc;
  1432. end;
  1433.  
  1434. procedure TDCMessageWindow.SetBitmap(Value: TBitmap);
  1435. begin
  1436.   if FBitmap <> Value then begin
  1437.      FBitmap.Assign(Value);
  1438.      BitmapVisible := True;
  1439.   end;
  1440. end;
  1441.  
  1442. procedure TDCMessageWindow.SetBitmapVisible(Value: boolean);
  1443. begin
  1444.   if FBitmapVisible <> Value then
  1445.   begin
  1446.     FBitmapVisible := Value;
  1447.     if FUpdateCount = 0 then AdjustWindowSize;
  1448.   end;
  1449. end;
  1450.  
  1451. procedure TDCMessageWindow.CMTextChanged(var Message: TMessage);
  1452. begin
  1453.   inherited;
  1454.   case FDialogStyle of
  1455.     dsSimple,
  1456.     dsInvalidValue : if FUpdateCount = 0 then AdjustWindowSize;
  1457.     dsCustom       : if FUpdateCount = 0 then AdjustWindowSize;
  1458.   end;
  1459. end;
  1460.  
  1461. procedure TDCMessageWindow.Show;
  1462. begin
  1463.   inherited;
  1464.   if FAutoHide then StartTimer(FTimeOut);
  1465. end;
  1466.  
  1467. function TDCMessageWindow.AddButton(AName, AResource, ACaption: string;
  1468.   AClick: TNotifyEvent): TDCEditButton;
  1469.  var
  1470.   P: TPoint;
  1471.   Pos: integer;
  1472.   ABounds: TRect;
  1473. begin
  1474.   if ACaption = '' then ACaption := 'null';
  1475.  
  1476.   if FButtons.Count > 0 then
  1477.     with FButtons do Pos := Buttons[Count-1].Left - 3
  1478.   else
  1479.     Pos := Self.Width - 3;
  1480.  
  1481.   Result := FButtons.AddButtonEx(TDCHintButton);
  1482.   SetMargins;
  1483.   with Result do
  1484.   begin
  1485.     Name := AName;
  1486.     BrushColor   := clBtnFace;
  1487.     if AResource <> '' then
  1488.       Glyph.LoadFromResourceName(hInstance, PChar(AResource));
  1489.     BrushColor   := clHintBackground;
  1490.     Allignment   := abCenter;
  1491.     AnchorStyle  := asBR;
  1492.     Font         := Self.Font;
  1493.     Caption      := ACaption;
  1494.     OnClick      := AClick;
  1495.     Self.Canvas.Font  := Font;
  1496.  
  1497.     P := Result.TextSize;
  1498.  
  1499.     if Assigned(Glyph) then
  1500.     begin
  1501.       P.X := P.X + Glyph.Width + ButtonOffset + TextBtnOffset;
  1502.     end;
  1503.     P.X := P.X + 4;
  1504.     P.Y := P.Y + 8;
  1505.     if FMessageStyle <> msNormal then
  1506.       ABounds := Rect(Pos - P.X - FRoundValue + 2,
  1507.         Self.Height - P.Y - FMargins.Bottom - FRoundValue + 2, P.X, P.Y)
  1508.     else
  1509.       ABounds := Rect(Pos-P.X, Self.Height - P.Y - FMargins.Bottom, P.X, P.Y);
  1510.     SetBounds(ABounds);
  1511.   end;
  1512.   if FUpdateCount = 0 then AdjustWindowSize;
  1513. end;
  1514.  
  1515. procedure TDCMessageWindow.CMMouseLeave(var Message: TMessage);
  1516. begin
  1517.   inherited;
  1518.   if Assigned(FButtons) then
  1519.     FButtons.UpdateButtons(-1, -1, FButtons.MouseDown, True);
  1520. end;
  1521.  
  1522. procedure TDCMessageWindow.SetMargins;
  1523. begin
  1524.   with FMargins do
  1525.   begin
  1526.     Left  := 4;
  1527.     Top   := 2;
  1528.     Right := 2;
  1529.     Bottom:= 2
  1530.   end;
  1531. end;
  1532.  
  1533. procedure TDCMessageWindow.SetAutoHide(const Value: boolean);
  1534. begin
  1535.   FAutoHide := Value;
  1536. end;
  1537.  
  1538. procedure TDCMessageWindow.WMTimer(var Message: TWMTimer);
  1539. begin
  1540.   StopTimer;
  1541.   inherited;
  1542. end;
  1543.  
  1544. procedure TDCMessageWindow.SetTimeOut(const Value: integer);
  1545. begin
  1546.   FTimeOut := Value;
  1547. end;
  1548.  
  1549. procedure TDCMessageWindow.StartTimer(Value: Integer);
  1550. begin
  1551.   StopTimer;
  1552.   if FButtons.Count = 0 then FTimerHandle := SetTimer(Handle, 1, Value, nil);
  1553. end;
  1554.  
  1555. procedure TDCMessageWindow.StopTimer;
  1556. begin
  1557.   if FTimerHandle <> 0 then
  1558.   begin
  1559.     KillTimer(0, FTimerHandle);
  1560.     FTimerHandle := 0;
  1561.     if Assigned(FOwner) and (FOwner is TWinControl) and
  1562.       TWinControl(FOwner).HandleAllocated then
  1563.       PostMessage(TWinControl(FOwner).Handle, CM_ERRORMESSAGE, 0, 0)
  1564.     else
  1565.       Hide;
  1566.   end;
  1567. end;
  1568.  
  1569. procedure TDCMessageWindow.WMEraseBkgnd(var Message: TWmEraseBkgnd);
  1570. begin
  1571.   Message.Result := 0;
  1572. end;
  1573.  
  1574. function TDCMessageWindow.GetRegion(RegionType: integer): HRGN;
  1575.  var
  1576.   FRect: TRect;
  1577.   Tail: HRGN;
  1578.  
  1579.   function CreatePolyRgn(const Points: array of TPoint): HRgn;
  1580.   type
  1581.     PPoints = ^TPoints;
  1582.     TPoints = array[0..0] of TPoint;
  1583.   begin
  1584.     Result := CreatePolygonRgn(PPoints(@Points)^, High(Points) + 1, WINDING);
  1585.   end;
  1586.  
  1587. begin
  1588.   FRect  := ClientRect;
  1589.   Result :=  NULLREGION;
  1590.   case FMessageStyle of
  1591.     msNormal:
  1592.       begin
  1593.         InflateRect(FRect, 1 , 1);
  1594.         Result := CreateRectRgnIndirect(FRect);
  1595.       end;
  1596.     msRoundRect:
  1597.       Result := CreateRoundRectRgn(FRect.Left, FRect.Top, FRect.Right,
  1598.         FRect.Bottom, FRoundValue, FRoundValue);
  1599.     msTail:
  1600.       begin
  1601.         Tail :=  0;
  1602.         case FOrientation of
  1603.           0:
  1604.             begin
  1605.               Tail := CreatePolyRgn([Point(8, FTailValue), Point(8, 0),
  1606.                 Point(FTailValue + 8, FTailValue)]);
  1607.               FRect.Top := FRect.Top + FTailValue;
  1608.             end;
  1609.           1:
  1610.             begin
  1611.               Tail := 0;
  1612.               FRect.Bottom := FRect.Bottom - FTailValue;
  1613.             end;
  1614.           2:
  1615.             begin
  1616.               Tail := CreatePolyRgn([Point(FRect.Right-8, FTailValue),
  1617.                 Point(FRect.Right-8, 0), Point(FRect.Right-8-FTailValue, FTailValue)]);
  1618.               FRect.Top := FRect.Top + FTailValue;
  1619.             end;
  1620.           3:
  1621.             begin
  1622.               Tail := 0;
  1623.               FRect.Bottom := FRect.Bottom - FTailValue;
  1624.             end;
  1625.           4:
  1626.             begin
  1627.               Tail := CreatePolyRgn([Point((FRect.Left + FRect.Right) div 2 - 4, FTailValue),
  1628.                 Point((FRect.Left + FRect.Right) div 2, 0),
  1629.                 Point((FRect.Left + FRect.Right) div 2 + 4, FTailValue)]);
  1630.               FRect.Top := FRect.Top + FTailValue;
  1631.             end;
  1632.         end;
  1633.         try
  1634.           Result := CreateRoundRectRgn(FRect.Left, FRect.Top, FRect.Right,
  1635.             FRect.Bottom, FRoundValue, FRoundValue);
  1636.           CombineRgn(Result, Result, Tail, RGN_OR);
  1637.         finally
  1638.           DeleteObject(Tail);
  1639.         end;
  1640.         FRect.Top :=  FRect.Top;
  1641.       end;
  1642.   end;
  1643. end;
  1644.  
  1645. procedure TDCMessageWindow.SetMessageStyle(const Value: TMessageStyle);
  1646. begin
  1647.   Hide;
  1648.   if FUpdateCount = 0 then AdjustWindowSize;
  1649.   FMessageStyle := Value;
  1650. end;
  1651.  
  1652. procedure TDCMessageWindow.SetCentered(const Value: boolean);
  1653. begin
  1654.   FCentered := Value;
  1655.   invalidate;
  1656. end;
  1657.  
  1658. procedure TDCMessageWindow.SetMaxTextWidth(const Value: integer);
  1659. begin
  1660.   FMaxTextWidth := Value;
  1661.   if FUpdateCount = 0 then AdjustWindowSize;
  1662. end;
  1663.  
  1664. procedure TDCMessageWindow.BeginUpdate;
  1665. begin
  1666.   Inc(FUpdateCount);
  1667. end;
  1668.  
  1669. procedure TDCMessageWindow.EndUpdate;
  1670. begin
  1671.   Dec(FUpdateCount);
  1672.   if FUpdateCount < 0 then FUpdateCount := 0;
  1673.   if FUpdateCount = 0 then AdjustWindowSize;
  1674. end;
  1675.  
  1676. procedure TDCMessageWindow.SetOrientation(const Value: integer);
  1677. begin
  1678.   if Orientation <> Value then
  1679.   begin
  1680.     inherited;
  1681.     UpdateWindowRegion;
  1682.   end;
  1683. end;
  1684.  
  1685. procedure TDCMessageWindow.UpdateWindowRegion;
  1686.  var
  1687.   ARgn: HRgn;
  1688. begin
  1689.   if HandleAllocated then
  1690.   begin
  1691.     ARgn := GetRegion(1);
  1692.     SetWindowRgn(Handle, ARgn, True);
  1693.   end;
  1694. end;
  1695.  
  1696. procedure TDCMessageWindow.Hide;
  1697. begin
  1698.   StopTimer;
  1699.   inherited;
  1700. end;
  1701.  
  1702. procedure TDCMessageWindow.Resize;
  1703. begin
  1704.   inherited;
  1705.   UpdateWindowRegion;
  1706. end;
  1707.  
  1708. procedure TDCMessageWindow.SetAutoSize(const Value: boolean);
  1709. begin
  1710.   if FAutoSize <> Value then
  1711.   begin
  1712.     FAutoSize := Value;
  1713.     if FAutoSize then AdjustWindowSize;
  1714.   end
  1715. end;
  1716.  
  1717. procedure TDCMessageWindow.CMFontChanged(var Message: TMessage);
  1718. begin
  1719.   inherited;
  1720.   Canvas.Font := Font;
  1721. end;
  1722.  
  1723. { TDCPopupDBGrid }
  1724.  
  1725. procedure TDCPopupDBGrid.AdjustNewHeight;
  1726. var
  1727.   DC: HDC;
  1728.   SaveFont: HFONT;
  1729.   Metrics: TTextMetric;
  1730. begin
  1731.   DC := GetDC(0);
  1732.   SaveFont := SelectObject(DC, Font.Handle);
  1733.   try
  1734.     GetTextMetrics (DC, Metrics);
  1735.     FItemHeight := Metrics.tmHeight;
  1736.     if dgRowLines in Options then
  1737.       FItemHeight := FItemHeight + 5
  1738.     else
  1739.       FItemHeight := FItemHeight + 3;
  1740.   finally
  1741.     SelectObject(DC, SaveFont);
  1742.     ReleaseDC(0, DC);
  1743.   end;
  1744. end;
  1745.  
  1746. constructor TDCPopupDBGrid.Create(AOwner: TComponent);
  1747. begin
  1748.   inherited Create(AOwner);
  1749.   FVisible    := False;
  1750.   ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable,
  1751.                                   csAcceptsControls];
  1752.  
  1753.   Visible := False;
  1754.  
  1755.   Canvas.Brush.Style := bsClear;
  1756.   FAlwaysVisible := True;
  1757.   FOwner := TControl(AOwner);
  1758.   Font   := TPrivateControl(AOwner).Font;
  1759.   TitleFont := TPrivateControl(AOwner).Font;
  1760.  
  1761.   SetRectEmpty(FWindowRect);
  1762.   SetRectEmpty(FMargins);
  1763.   FDropDownRows := 8;
  1764.  
  1765.   FDataSource := TDataSource.Create(Self);
  1766.   FDataSource.DataSet := FDataSet;
  1767.   DataSource  := FDataSource;
  1768.   AdjustNewHeight;
  1769.  
  1770.   {Special Grid properies}
  1771.  
  1772.   BorderStyle := bsNone;
  1773.   Options := Options + [dgRowSelect, dgAlwaysShowSelection, dgHighlightRow,
  1774.     dgTitleClicked, dgCompleteLines, dgFlatButtons];
  1775.   Options := Options - [dgIndicator, dgRowLines];
  1776.   ScrollBars  := ssNone;
  1777.   FCursorMode := cmNone;
  1778.  
  1779.   FButtons := TDCEditButtons.Create(Self);
  1780.   FButtons.AnchorStyle := asBL;
  1781.   FButtons.Color := clBtnFace;
  1782.   FButtons.OnlyClientRepaint := True;
  1783.  
  1784.   FShowHeader := True;
  1785.  
  1786.   OnPaintEmptyMessage := PaintEmptyMessage;
  1787. end;
  1788.  
  1789. procedure TDCPopupDBGrid.CreateParams(var Params: TCreateParams);
  1790. begin
  1791.   inherited CreateParams(Params);
  1792.   with Params do
  1793.   begin
  1794.     ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST ;
  1795.     AddBiDiModeExStyle(ExStyle);
  1796.   end;
  1797. end;
  1798.  
  1799. procedure TDCPopupDBGrid.CreateWnd;
  1800.  var
  1801.   LeftPos: integer;
  1802.   AButton: TDCEditButton;
  1803. begin
  1804.   inherited CreateWnd;
  1805.  
  1806.   if Parent <> nil then
  1807.   begin
  1808.     Windows.SetParent(Handle, 0);
  1809.     CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
  1810.     SetMargins;
  1811.  
  1812.     FButtons.SetWndProc;
  1813.  
  1814.     if FShowHeader then
  1815.     begin
  1816.       LeftPos := 4;
  1817.       FButtons.Clear;
  1818.  
  1819.       if FCanAppend then begin
  1820.         AButton := FButtons.AddButton;
  1821.         with AButton do
  1822.         begin
  1823.           Name := '#Append';
  1824.           Allignment  := abLeft;
  1825.           AnchorStyle := asBL;
  1826.           Font     := Self.Font;
  1827.           Color   := Self.Color;
  1828.           DrawText := False;
  1829.           Glyph.LoadFromResourceName(HInstance, 'DC_SBTNNEW');
  1830.           Caption := 'Append';
  1831.  
  1832.           SetBounds(Rect(LeftPos, Self.Height-br_FooterHeight-5,
  1833.             Glyph.Width + 5, br_FooterHeight+3));
  1834.  
  1835.           DisableStyle := deNormal;
  1836.           Style   := stShadowFlat;
  1837.           Enabled := True;
  1838.           Visible := False;
  1839.           Tag     := 3;
  1840.           OnClick := DoButtonClick;
  1841.           OnDrawHint := DoDrawHint;
  1842.         end;
  1843.         LeftPos := LeftPos + AButton.Width;
  1844.       end;
  1845.  
  1846.       AButton := FButtons.AddButton;
  1847.       with AButton do                         
  1848.       begin
  1849.         Name := '#Refresh';
  1850.         Allignment  := abLeft;
  1851.         AnchorStyle := asBL;
  1852.         Font     := Self.Font;
  1853.         Color   := Self.Color;
  1854.         DrawText := False;
  1855.         Glyph.LoadFromResourceName(HInstance, 'DC_SBTNREFRESH');
  1856.         Caption := 'Refresh';
  1857.  
  1858.         SetBounds(Rect(LeftPos, Self.Height-br_FooterHeight-5,
  1859.           Glyph.Width + 5, br_FooterHeight+3));
  1860.  
  1861.         DisableStyle := deNormal;
  1862.         Style   := stShadowFlat;
  1863.         Enabled := True;
  1864.         Visible := False;
  1865.         Tag     := 1;
  1866.         OnClick := DoButtonClick;
  1867.         OnDrawHint := DoDrawHint;
  1868.       end;
  1869.       LeftPos := LeftPos + AButton.Width;
  1870.  
  1871.       AButton := FButtons.AddButton;
  1872.       with AButton do
  1873.       begin
  1874.         Name := '#Sep_1';
  1875.         Allignment  := abImageTop;
  1876.         AnchorStyle := asBL;
  1877.         Font     := Self.Font;
  1878.         Glyph.LoadFromResourceName(HInstance, 'DC_DELIMITER');
  1879.  
  1880.         SetBounds(Rect(LeftPos, Self.Height-br_FooterHeight-5,
  1881.           8, br_FooterHeight+3));
  1882.  
  1883.         DisableStyle := deNormal;
  1884.         Style   := stNone;
  1885.         Enabled := True;
  1886.         Visible := False;
  1887.         DrawText:= False;
  1888.         Tag     := -1;
  1889.         OnDrawHint := DoDrawHint;
  1890.       end;
  1891.       LeftPos := LeftPos + AButton.Width;
  1892.  
  1893.       FFindButton := FButtons.AddButton;
  1894.       with FFindButton do
  1895.       begin
  1896.         Name := '#SearchText';
  1897.         Allignment := abLeft;
  1898.         AnchorStyle := asBLR;
  1899.         Font    := Self.Font;
  1900.         Color   := Self.Color;
  1901.         Glyph.LoadFromResourceName(HInstance, 'DC_SBTNFILTER');
  1902.         Caption := '';
  1903.  
  1904.         SetBounds(Rect(LeftPos, Self.Height-br_FooterHeight-5,
  1905.           Self.Width - LeftPos - 2*FBorderSize - 45,
  1906.           br_FooterHeight+3));
  1907.  
  1908.         DisableStyle := deNormal;
  1909.         Style   := stNone;
  1910.         Enabled := False;
  1911.         Visible := False;
  1912.         Tag     := 2;
  1913.         OnClick := DoButtonClick;
  1914.       end;
  1915.       LeftPos := LeftPos + FFindButton.Width;
  1916.  
  1917.       FScrollLeft := FButtons.AddButton;
  1918.       with FScrollLeft do
  1919.       begin
  1920.         Name := '#ScrollLeft';
  1921.         Allignment  := abCenter;
  1922.         AnchorStyle := asBR;
  1923.         Font     := Self.Font;
  1924.         Color   := Self.Color;
  1925.         DrawText := False;
  1926.         Glyph.LoadFromResourceName(HInstance, 'DC_BTNLEFT');
  1927.         Caption := 'ScrollLeft';
  1928.  
  1929.         SetBounds(Rect(LeftPos, Self.Height-br_FooterHeight-5, 14, br_FooterHeight+3));
  1930.  
  1931.         DisableStyle := deNormal;
  1932.         Style   := stShadowFlat;
  1933.         Enabled := False;
  1934.         Visible := False;
  1935.         Tag     := 3;
  1936.         OnClick := DoScroll;
  1937.         OnDrawHint := DoDrawHint;
  1938.       end;
  1939.       LeftPos := LeftPos + FScrollLeft.Width;
  1940.  
  1941.       FScrollRight := FButtons.AddButton;
  1942.       with FScrollRight do
  1943.       begin
  1944.         Name := '#ScrollRight';
  1945.         Allignment  := abCenter;
  1946.         AnchorStyle := asBR;
  1947.         Font     := Self.Font;
  1948.         Color   := Self.Color;
  1949.         DrawText := False;
  1950.         Glyph.LoadFromResourceName(HInstance, 'DC_BTNRIGHT');
  1951.         Caption := 'ScrollRight';
  1952.  
  1953.         SetBounds(Rect(LeftPos, Self.Height-br_FooterHeight-5, 14, br_FooterHeight+3));
  1954.  
  1955.         DisableStyle := deNormal;
  1956.         Style   := stShadowFlat;
  1957.         Enabled := False;
  1958.         Visible := False;
  1959.         Tag     := 4;
  1960.         OnClick := DoScroll;
  1961.         OnDrawHint := DoDrawHint;
  1962.       end;
  1963.     end;
  1964.   end;
  1965. end;
  1966.  
  1967. procedure TDCPopupDBGrid.Hide;
  1968. begin
  1969.   HideWindow(Handle);
  1970.   FVisible := False;
  1971. end;
  1972.  
  1973. procedure TDCPopupDBGrid.RedrawBorder;
  1974.  var
  1975.   DC: HDC;
  1976.   R: TRect;
  1977.   ABrush: HBRUSH;
  1978. begin
  1979.   DC := GetWindowDC(Handle);
  1980.   try
  1981.     GetWindowRect(Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  1982.     case FPopupBorderStyle of
  1983.       brNone:;
  1984.       brSingle:
  1985.         begin
  1986.           ABrush := CreateSolidBrush(clBlack);
  1987.           FrameRect( DC, R, ABrush);
  1988.           DeleteObject(ABrush);
  1989.         end;
  1990.       brRaised:
  1991.         begin
  1992.           DrawEdge(DC, R, BDR_RAISEDOUTER, BF_RECT);
  1993.           InflateRect(R, -1, -1);
  1994.           DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT);
  1995.  
  1996.           DrawHeader;
  1997.           DrawClientRect;
  1998.           DrawFooter;
  1999.         end;
  2000.     end;
  2001.   finally
  2002.     ReleaseDC(Handle, DC);
  2003.   end;
  2004. end;
  2005.  
  2006. procedure TDCPopupDBGrid.SetPopupBorderStyle(Value: TPopupBorderStyle);
  2007. begin
  2008.   if FPopupBorderStyle <> Value then
  2009.   begin
  2010.     FPopupBorderStyle := Value;
  2011.     case FPopupBorderStyle of
  2012.       brNone  :FBorderSize := 0;
  2013.       brSingle:FBorderSize := 1;
  2014.       brRaised:FBorderSize := 2;
  2015.     end;
  2016.     RecreateWnd;
  2017.   end;
  2018. end;
  2019.  
  2020. procedure TDCPopupDBGrid.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  2021. begin
  2022.   if AHeight < FItemHeight * 5 then AHeight := FItemHeight * 5;
  2023.   if AWidth  < 80 then AWidth  := 80;
  2024.   inherited;
  2025.   FWindowRect := Rect(Left,Top,Left+Width,Top+Height);
  2026. end;
  2027.  
  2028. procedure TDCPopupDBGrid.SetBoundsEx(ALeft, ATop, AWidth,
  2029.   AHeight: Integer);
  2030. begin
  2031.   FWindowRect := Rect(ALeft,ATop,ALeft+AWidth,aTop+AHeight);
  2032.   if FVisible then Show;
  2033. end;
  2034.  
  2035. procedure TDCPopupDBGrid.SetPopupAlignment(Value: TWindowAlignment);
  2036. begin
  2037.   if Value <> FPopupAlignment then
  2038.   begin
  2039.     FPopupAlignment := Value;
  2040.     if Visible then Show;
  2041.   end;
  2042. end;
  2043.  
  2044. procedure TDCPopupDBGrid.Show;
  2045. begin
  2046.   SetMargins;
  2047.   Height := FItemHeight*FDropDownRows + RowHeights[0] + 2*FBorderSize + FMargins.Top + FMargins.Bottom;
  2048.   ShowWindow(Handle, FPopupAlignment, FWindowRect, FAlwaysVisible, Owner);
  2049.   FVisible  := True;
  2050.   CheckRefreshButton;
  2051.   UpdateHScrolls;
  2052. end;
  2053.  
  2054. procedure TDCPopupDBGrid.WMMouseActivate(var Message: TWMActivate);
  2055. begin
  2056.   inherited;
  2057.   Message.Result := MA_NOACTIVATE;
  2058.   SetWindowPos (Handle, HWND_TOP, 0, 0, 0, 0,
  2059.      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  2060. end;
  2061.  
  2062. procedure TDCPopupDBGrid.WMNCCalcSize(var Message: TWMNCCalcSize);
  2063. begin
  2064.   case FPopupBorderStyle of
  2065.     brNone  :FBorderSize := 0;
  2066.     brSingle:
  2067.       begin
  2068.         FBorderSize := 2;
  2069.         InflateRect(Message.CalcSize_Params^.rgrc[0], -2, -2);
  2070.       end;
  2071.     brRaised:
  2072.       begin
  2073.         FBorderSize := 2;
  2074.         InflateRect(Message.CalcSize_Params^.rgrc[0], -2, -2);
  2075.       end;
  2076.   end;
  2077.   with Message.CalcSize_Params^.rgrc[0] do
  2078.   begin
  2079.     Top    := Top    + FMargins.Top;
  2080.     Left   := Left   + FMargins.Left;
  2081.     Bottom := Bottom - FMargins.Bottom;
  2082.     Right  := Right  - FMargins.Right;
  2083.   end;
  2084.   inherited;
  2085. end;
  2086.  
  2087. procedure TDCPopupDBGrid.WMNCPaint(var Message: TWMNCPaint);
  2088. begin
  2089.   inherited;
  2090.   RedrawBorder;
  2091. end;
  2092.  
  2093. procedure TDCPopupDBGrid.SetDataSet(const Value: TDataSet);
  2094. begin
  2095.   FDataSet := Value;
  2096.   FDataSource.DataSet := FDataSet;
  2097.   CheckRefreshButton;
  2098. end;
  2099.  
  2100. function TDCPopupDBGrid.HighlightCell(DataCol, DataRow: Integer;
  2101.   const Value: string; AState: TGridDrawState): Boolean;
  2102. begin
  2103.   Result :=  inherited HighlightCell(DataCol, DataRow, Value, AState);
  2104. end;
  2105.  
  2106. procedure TDCPopupDBGrid.WMFontChange(var Message: TWMFontChange);
  2107.  var
  2108.   i: integer;
  2109. begin
  2110.   inherited;
  2111.   AdjustNewHeight;
  2112.   for i := 0 to FButtons.Count-1 do
  2113.     FButtons.Buttons[i].Font := Font;
  2114. end;
  2115.  
  2116. procedure TDCPopupDBGrid.WMLButtonDblClk(var Message: TWMLButtonDown);
  2117. begin
  2118.   inherited;
  2119. end;
  2120.  
  2121. procedure TDCPopupDBGrid.WMNCHitTest(var Message: TWMNCHitTest);
  2122.  var
  2123.   R, WindowR: TRect;
  2124.   BS: Integer;
  2125.   Button: TDCEditButton;
  2126.  function InCaptArea(XPos, YPos: integer): boolean;
  2127.  begin
  2128.    R := WindowR;
  2129.    InflateRect(R, -BS, -BS);
  2130.    R.Bottom := R.Top + br_HeaderHeight;
  2131.    Result := PtInRect(R, Point(XPos, YPos));
  2132.  end;
  2133.  function InSizeArea(XPos, YPos: integer): boolean;
  2134.  begin
  2135.    R := WindowR;
  2136.    InflateRect(R, -BS, -BS);
  2137.    R.Top  := R.Bottom - br_FooterHeight;
  2138.    R.Left := R.Right  - br_SizerWidth;
  2139.    Result := PtInRect(R, Point(XPos, YPos));
  2140.  end;
  2141.  function InGridArea(XPos, YPos: integer): boolean;
  2142.  begin
  2143.    R := WindowR;
  2144.    InflateRect(R, -BS, -BS);
  2145.    R.Left   := R.Left   + FMargins.Left;
  2146.    R.Top    := R.Top    + FMargins.Top;
  2147.    R.Right  := R.Right  - FMargins.Right;
  2148.    R.Bottom := R.Bottom - FMargins.Bottom;
  2149.    Result := PtInRect(R, Point(XPos, YPos));
  2150.  end;
  2151.  function InButtonsArea(XPos, YPos: integer): boolean;
  2152.   var
  2153.    P: TPoint;
  2154.  begin
  2155.    P.X := XPos - Left;
  2156.    P.Y := YPos - Top;
  2157.    Result := FButtons.MouseInButtonArea(P.X, P.Y, Button);
  2158.    R := WindowR;
  2159.    InflateRect(R, -BS, -BS);
  2160.  end;
  2161.  function InFooterArea(XPos, YPos: integer): boolean;
  2162.  begin
  2163.    R := WindowR;
  2164.    InflateRect(R, -BS, -BS);
  2165.    R.Top  := R.Bottom - br_FooterHeight;
  2166.    Result := PtInRect(R, Point(XPos, YPos));
  2167.  end;
  2168. begin
  2169.   inherited;
  2170.   if not FShowHeader then begin
  2171.     FCursorMode := cmGrid;
  2172.     Exit;
  2173.   end;
  2174.  
  2175.   FCursorMode := cmNone;
  2176.   BS := FBorderSize;
  2177.   GetWindowRect(Handle, WindowR);
  2178.   with Message do
  2179.   begin
  2180.     if InCaptArea(XPos, YPos) then
  2181.     begin
  2182.       FCursorMode := cmMove;
  2183.       Result := HTBORDER;
  2184.     end;
  2185.  
  2186.     if InFooterArea(XPos, YPos) then
  2187.     begin
  2188.       FCursorMode := cmFooter;
  2189.       Result := HTBORDER;
  2190.     end;
  2191.  
  2192.     if InSizeArea(XPos, YPos) then
  2193.     begin
  2194.       FCursorMode := cmResize;
  2195.       Result := HTSIZE;
  2196.     end;
  2197.  
  2198.     if InGridArea(XPos, YPos) then FCursorMode := cmGrid;
  2199.  
  2200.     if InButtonsArea(XPos, YPos) then
  2201.     begin
  2202.       FCursorMode := cmButtons;
  2203.       Result := HTBORDER;
  2204.     end;
  2205.   end;
  2206. end;
  2207.  
  2208. procedure TDCPopupDBGrid.SetParent(AParent: TWinControl);
  2209. begin
  2210.   inherited;
  2211.   if (AParent <> nil) and (AParent.Parent <> nil) and
  2212.      (AParent is TDCCustomChoiceEdit)
  2213.   then begin
  2214.     Caption := TDCCustomChoiceEdit(AParent).DBObject.Caption;
  2215.   end;
  2216. end;
  2217.  
  2218. procedure TDCPopupDBGrid.DrawFooter;
  2219.  var
  2220.   DC: HDC;
  2221.   R: TRect;
  2222.   Bitmap: TBitmap;
  2223. begin
  2224.   if not FShowHeader then Exit;
  2225.   DC := GetWindowDC(Handle);
  2226.   Bitmap := TBitmap.Create;
  2227.   try
  2228.     GetWindowRect (Handle, R); OffsetRect (R, -R.Left, -R.Top);
  2229.     InflateRect(R, -2, -2);
  2230.     Bitmap.LoadFromResourceName(HInstance, 'DC_BTNSIZE');
  2231.     R.Top := R.Bottom - br_FooterHeight - 4;
  2232.     FillRect(DC, R,  GetSysColorBrush(COLOR_BTNFACE));
  2233.  
  2234.     R.Left := R.Right-Bitmap.Width-2;
  2235.     R.Top  := R.Bottom-Bitmap.Height-2;
  2236.     DrawTransparentBitmap(DC, Bitmap, R, False, Bitmap.Canvas.Pixels[0,0]);
  2237.   finally
  2238.     Bitmap.Free;
  2239.     ReleaseDC(Handle, DC);
  2240.   end;
  2241. end;
  2242.  
  2243. procedure TDCPopupDBGrid.DrawHeader;
  2244.  var
  2245.   DC: HDC;
  2246.   R: TRect;
  2247. begin
  2248.   if not FShowHeader then Exit;
  2249.   DC := GetWindowDC(Handle);
  2250.   try
  2251.     GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  2252.     InflateRect(R, -2, -2);
  2253.     R.Bottom := R.Top + br_HeaderHeight;
  2254.     FillRect(DC, R,  GetSysColorBrush(COLOR_BTNFACE));
  2255.     R.Bottom := R.Bottom - 1;
  2256.     DrawCaption(Handle, DC, R, DC_TEXT or DC_SMALLCAP or DC_ACTIVE or DC_GRADIENT);
  2257.   finally
  2258.     ReleaseDC(Handle, DC);
  2259.   end;
  2260. end;
  2261.  
  2262. procedure TDCPopupDBGrid.WMSetCursor(var Message: TWMSetCursor);
  2263. begin
  2264.   case FCursorMode of
  2265.     cmNone   : SetCursor(Screen.Cursors[crArrow]);
  2266.     cmResize : SetCursor(Screen.Cursors[crSizeNWSE]);
  2267.     cmMove   : SetCursor(Screen.Cursors[crArrow]);
  2268.     cmButtons: SetCursor(Screen.Cursors[crArrow]);
  2269.     cmFooter : SetCursor(Screen.Cursors[crArrow]);
  2270.     cmGrid   : inherited;
  2271.   end;
  2272. end;
  2273.  
  2274. procedure TDCPopupDBGrid.WMNCLButtonDown(var Message: TWMNCLButtonDown);
  2275. begin
  2276.   inherited;
  2277.   with Message do
  2278.   begin
  2279.     case FCursorMode of
  2280.       cmResize, cmMove: BeginMoving(XCursor, YCursor);
  2281.     end;
  2282.   end;
  2283. end;
  2284.  
  2285. procedure TDCPopupDBGrid.BeginMoving(XCursor, YCursor: integer);
  2286. begin
  2287.   ProcessMovingWindow(Self, XCursor, YCursor, FCursorMode, FItemHeight);
  2288. end;
  2289.  
  2290. procedure TDCPopupDBGrid.SetMargins;
  2291. begin
  2292.   FMargins := Rect(4,4,4,2);
  2293.   if not FShowHeader then Exit;
  2294.   case FPopupBorderStyle of
  2295.     brNone  :;
  2296.     brSingle:;
  2297.     brRaised:
  2298.       begin
  2299.         // Margins.Properties
  2300.         FMargins.Top  := FMargins.Top + br_HeaderHeight;
  2301.         FMargins.Bottom := FMargins.Bottom + br_FooterHeight + 4;
  2302.       end;
  2303.   end;
  2304. end;
  2305.  
  2306. destructor TDCPopupDBGrid.Destroy;
  2307. begin
  2308.   FDataSource.Free;
  2309.   FButtons.Free;
  2310.   FButtons := nil;
  2311.   inherited;
  2312. end;
  2313.  
  2314. procedure TDCPopupDBGrid.CMMouseEnter(var Message: TMessage);
  2315. begin
  2316.   inherited;
  2317.   if Assigned(FButtons) then
  2318.     FButtons.MouseDown := GetAsyncKeyState(VK_LBUTTON) < 0;
  2319. end;
  2320.  
  2321. procedure TDCPopupDBGrid.CMMouseLeave(var Message: TMessage);
  2322. begin
  2323.   inherited;
  2324.   if Assigned(FButtons) then
  2325.     FButtons.UpdateButtons( -1, -1, False, True);
  2326. end;
  2327.  
  2328. procedure TDCPopupDBGrid.WMPaint(var Message: TWMPaint);
  2329. begin
  2330.   if Assigned(FButtons) then FButtons.UpdateDeviceRegion(Message.DC);
  2331.   inherited;
  2332.   if Assigned(FButtons) then InvalidateButtons;
  2333. end;
  2334.  
  2335. procedure TDCPopupDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
  2336. begin
  2337.   inherited;
  2338.   case Key of
  2339.     VK_LEFT :
  2340.       begin
  2341.         if ssCtrl in Shift then
  2342.           SetBounds(Left-POPUP_MOVE_STEPX, Top, Width, Height);
  2343.       end;
  2344.     VK_RIGHT:
  2345.       begin
  2346.         if ssCtrl in Shift then
  2347.           SetBounds(Left+POPUP_MOVE_STEPX, Top, Width, Height);
  2348.       end;
  2349.     VK_UP   :
  2350.       begin
  2351.         if ssCtrl in Shift then
  2352.           SetBounds(Left, Top-POPUP_MOVE_STEPY, Width, Height);
  2353.       end;
  2354.     VK_DOWN :
  2355.       begin
  2356.         if ssCtrl in Shift then
  2357.           SetBounds(Left, Top+POPUP_MOVE_STEPY, Width, Height);
  2358.       end;
  2359.   end;
  2360. end;
  2361.  
  2362. procedure TDCPopupDBGrid.DoButtonClick(Sender: TObject);
  2363.  var
  2364.   ACursor: TCursor;
  2365. begin
  2366.   if Assigned(FOnButtonClick) then FOnButtonClick(Sender);
  2367.   case TDCEditButton(Sender).Tag of
  2368.     1{Refresh}:
  2369.       if FDataSet <> nil  then
  2370.       begin
  2371.         ACursor := Screen.Cursor;
  2372.         Screen.Cursor := crHourGlass;
  2373.         try
  2374.           SavePosition;
  2375.           FDataSet.DisableControls;
  2376.           try
  2377.             {$IFDEF DELPHI_V5UP}
  2378.             if GetPropValue(FDataSet, 'TableName', False) <> null then
  2379.             {$ELSE}
  2380.             if False then
  2381.             {$ENDIF}
  2382.               FDataSet.Refresh
  2383.             else begin
  2384.               FDataSet.Close;
  2385.               FDataSet.Open;
  2386.             end;
  2387.           except
  2388.             on E: Exception do
  2389.             begin
  2390.               if Assigned(FOwner) and (FOwner is TDCCustomEdit) then
  2391.               begin
  2392.                 TDCCustomEdit(FOwner).ErrorCode := ERR_GRID_EXCEPTONREFRESH;
  2393.                 TDCCustomEdit(FOwner).ErrorHint := E.Message;
  2394.                 TDCCustomEdit(FOwner).ShowErrorMessage;
  2395.               end;
  2396.             end;
  2397.           end;
  2398.         finally
  2399.           FDataSet.EnableControls;
  2400.           RestPosition;
  2401.           Screen.Cursor := ACursor;
  2402.         end;
  2403.       end;
  2404.     3{New}:
  2405.       if Assigned(FOwner) and (FOwner is TDCCustomGridEdit) then
  2406.         PostMessage(TWinControl(FOwner).Handle, CM_APPENDRECORD, 0, 0)
  2407.   end;
  2408. end;
  2409.  
  2410. procedure TDCPopupDBGrid.WMSize(var Message: TWMSize);
  2411. begin
  2412.   inherited;
  2413.   if Assigned(FButtons) then InvalidateButtons;
  2414.   UpdateHScrolls;
  2415. end;
  2416.  
  2417. procedure TDCPopupDBGrid.InvalidateButtons;
  2418.  var
  2419.   i, RightPos: integer;
  2420.   Button: TDCEditButton;
  2421.   Changed: boolean;
  2422. begin
  2423.   RightPos := Width - br_SizerWidth - FBorderSize - 3;
  2424.   Changed  := False;
  2425.   for i := 0 to FButtons.Count-1 do
  2426.   begin
  2427.     Button := FButtons.Buttons[i];
  2428.     if (Button.Left + Button.Width) > RightPos then
  2429.     begin
  2430.       if Button.Visible then
  2431.       begin
  2432.         Button.Visible := False;
  2433.         Changed := True;
  2434.       end
  2435.     end
  2436.     else
  2437.       if not Button.Visible then
  2438.       begin
  2439.         Button.Visible := True;
  2440.         Changed := True;
  2441.       end;
  2442.   end;
  2443.  
  2444.   if Changed then SendMessage(Self.Handle, WM_NCPAINT, 0, 0);
  2445. end;
  2446.  
  2447. procedure TDCPopupDBGrid.SetShowHeader(const Value: boolean);
  2448. begin
  2449.   FShowHeader := Value;
  2450.   RecreateWnd;
  2451. end;
  2452.  
  2453. procedure TDCPopupDBGrid.StartSearch(Key: Char; AValue: string = '');
  2454.  var
  2455.   ASearch, ADate: string;
  2456.   VLocate: variant;
  2457.   ACursor:TCursor;
  2458. begin
  2459.   KillTimer(Handle, SRCTIMER_IDEVENT);
  2460.   FFindButton.Enabled := True;
  2461.  
  2462.   ACursor := Screen.Cursor;
  2463.   Screen.Cursor := crHourGlass;
  2464.   if AValue = '' then
  2465.   begin
  2466.     case Key of
  2467.       #8:
  2468.         begin
  2469.           ASearch := FFindButton.Caption;
  2470.           ASearch := Copy(ASearch, 1, Length(ASearch)-1);
  2471.         end;
  2472.       else
  2473.         ASearch := FFindButton.Caption + Key;
  2474.     end;
  2475.   end
  2476.   else
  2477.     ASearch := AValue;
  2478.   VLocate := null;
  2479.  
  2480.   try
  2481.     if Assigned(SelectedField) then
  2482.     begin
  2483.       if SelectedField.FieldKind = fkLookup then
  2484.       begin
  2485.         if SelectedField.LookUpDataSet.Locate(
  2486.              SelectedField.LookUpResultField, ASearch,[loCaseInsensitive,loPartialKey]) then
  2487.            DataSet.Locate(SelectedField.KeyFields,
  2488.              SelectedField.LookUpDataSet.FieldByName(SelectedField.LookUpKeyFields).AsString,
  2489.              [loCaseInsensitive, loPartialKey]);
  2490.       end
  2491.       else begin
  2492.         case SelectedField.DataType of
  2493.          ftString, ftWideString:
  2494.            VLocate := ASearch;
  2495.          ftAutoInc, ftInteger, ftSmallInt, ftWord, ftLargeInt:
  2496.            if IsValidInteger(ASearch) then VLocate := StrToInt(ASearch);
  2497.          ftFloat:
  2498.            if IsValidFloat(ASearch) then VLocate := StrToFloat(ASearch);
  2499.          ftCurrency:
  2500.            if IsValidCurrency(ASearch, CurrencyDecimals) then VLocate := StrToCurr(ASearch);
  2501.          ftDate, ftTime, ftDateTime:
  2502.            if DateToStrY2K(ASearch, ADate) then VLocate := StrToDateTime(ADate);
  2503.         end;
  2504.  
  2505.         if VLocate <> null then
  2506.            DataSource.DataSet.Locate(SelectedField.FieldName, VLocate,
  2507.              [loCaseInsensitive, loPartialKey]);
  2508.       end;
  2509.     end;
  2510.  
  2511.   except
  2512.     ASearch := FFindButton.Caption;
  2513.   end;
  2514.  
  2515.   FFindButton.Caption := ASearch;
  2516.   FFindButton.Invalidate;
  2517.   Screen.Cursor := ACursor;
  2518.   SetTimer(Handle, SRCTIMER_IDEVENT, 2000, nil);
  2519. end;
  2520.  
  2521. procedure TDCPopupDBGrid.StopSearch;
  2522. begin
  2523.   FFindButton.Enabled := False;
  2524.   FFindButton.Caption := '';
  2525.   FFindButton.Invalidate;
  2526.   KillTimer(Handle, SRCTIMER_IDEVENT)
  2527. end;
  2528.  
  2529. procedure TDCPopupDBGrid.KeyPress(var Key: Char);
  2530. begin
  2531.   inherited;
  2532.   StartSearch(Key);
  2533. end;
  2534.  
  2535. procedure TDCPopupDBGrid.WMTimer(var Message: TWMTimer);
  2536. begin
  2537.   inherited;
  2538.   case Message.TimerID of
  2539.     SRCTIMER_IDEVENT: StopSearch;
  2540.     SLLTIMER_IDEVENT:
  2541.       begin
  2542.         if FScrollLeft.ButtonState  = btDownMouseInRect then DoScroll(FScrollLeft);
  2543.         if FScrollRight.ButtonState = btDownMouseInRect then DoScroll(FScrollRight);
  2544.         if FScrollTimer <> 0 then
  2545.         begin
  2546.           KillTimer(FScrollTimer, 1);
  2547.           FScrollTimer := SetTimer(Handle, SLLTIMER_IDEVENT, 200, nil);
  2548.         end;
  2549.       end;
  2550.   end;
  2551. end;
  2552.  
  2553. procedure TDCPopupDBGrid.SetCanAppend(const Value: boolean);
  2554. begin
  2555.   if FCanAppend <> Value then
  2556.   begin
  2557.     FCanAppend := Value;
  2558.     RecreateWnd;
  2559.   end;
  2560. end;
  2561.  
  2562. procedure TDCPopupDBGrid.DoDrawHint(Sender: TObject; Mode: Integer);
  2563. begin
  2564.   {}
  2565. end;
  2566.  
  2567. procedure TDCPopupDBGrid.CheckRefreshButton;
  2568.  var
  2569.   Button: TDCEditButton;
  2570. begin
  2571.   Button := FButtons.FindButton('#Refresh');
  2572.   if Button <> nil then
  2573.   begin
  2574.     Button.Visible := FDataSet <> nil;
  2575.   end;
  2576. end;
  2577.  
  2578. procedure TDCPopupDBGrid.CMSetAlignment(var Message: TMessage);
  2579. begin
  2580.   PopupAlignment := TWindowAlignment(Message.WParam);
  2581. end;
  2582.  
  2583. procedure TDCPopupDBGrid.CMHintShow(var Message: TCMHintShow);
  2584. begin
  2585.   inherited;
  2586. end;
  2587.  
  2588. procedure TDCPopupDBGrid.WMNCMouseMove(var Message: TWMNCMouseMove);
  2589. begin
  2590.   inherited;
  2591. end;
  2592.  
  2593. function TDCPopupDBGrid.MouseUpBeforeDblClk: boolean;
  2594. begin
  2595.   Result := True;
  2596. end;
  2597.  
  2598. procedure TDCPopupDBGrid.PaintEmptyMessage(Sender: TObject;
  2599.   Canvas: TCanvas; ARect: TRect; UpdateMessage: string);
  2600. begin
  2601.   Canvas.FillRect(ARect);
  2602.   ARect.Left  := ARect.Left + FBorderSize;
  2603.   ARect.Right := ARect.Right - FMargins.Right - FMargins.Left - 2*FBorderSize;
  2604.   DrawHighLightText(Canvas, PChar(UpdateMessage), ARect, 1, DT_END_ELLIPSIS or DT_CENTER or DT_WORDBREAK);
  2605. end;
  2606.  
  2607. procedure TDCPopupDBGrid.DoScroll(Sender: TObject);
  2608. begin
  2609.   if Sender is TDCEditButton then
  2610.   begin
  2611.     case TDCEditButton(Sender).Tag of
  2612.       3: {Left}
  2613.         begin
  2614.           if LeftCol > 0 then
  2615.             LeftCol := LeftCol - 1
  2616.           else if FScrollTimer <> 0 then
  2617.           begin
  2618.             KillTimer(0, FScrollTimer);
  2619.             FScrollTimer := 0;
  2620.           end;
  2621.         end;
  2622.       4: {Right}
  2623.         begin
  2624.           if LeftCol + VisibleColCount < ColCount then
  2625.             LeftCol := LeftCol + 1
  2626.           else if FScrollTimer <> 0 then
  2627.           begin
  2628.             KillTimer(0, FScrollTimer);
  2629.             FScrollTimer := 0;
  2630.           end;
  2631.         end;
  2632.     end;
  2633.   end;
  2634. end;
  2635.  
  2636. procedure TDCPopupDBGrid.TopLeftChanged;
  2637. begin
  2638.   inherited;
  2639.   UpdateHScrolls;
  2640. end;
  2641.  
  2642. procedure TDCPopupDBGrid.UpdateHScrolls;
  2643. begin
  2644.   if Assigned(FScrollLeft) then FScrollLeft.Enabled := LeftCol > 0;
  2645.   if Assigned(FScrollRight) then FScrollRight.Enabled := LeftCol + VisibleColCount < ColCount;
  2646. end;
  2647.  
  2648. procedure TDCPopupDBGrid.WMLButtonDown(var Message: TWMLButtonDown);
  2649.  var
  2650.   Button: TDCEditButton;
  2651.   Pos: TPoint;
  2652. begin
  2653.   inherited;
  2654.   GetCursorPos(Pos);
  2655.   if FButtons.MouseInButtonArea(Pos.X, Pos.Y, Button) then
  2656.   begin
  2657.     if (Button = FScrollLeft) or (Button = FScrollRight) then
  2658.       FScrollTimer := SetTimer(Handle, SLLTIMER_IDEVENT, 500, nil);
  2659.   end;
  2660. end;
  2661.  
  2662. procedure TDCPopupDBGrid.WMLButtonUp(var Message: TWMLButtonUp);
  2663. begin
  2664.   inherited;
  2665.   if FScrollTimer <> 0 then
  2666.   begin
  2667.     KillTimer(0, FScrollTimer);
  2668.     FScrollTimer := 0;
  2669.   end;
  2670. end;
  2671.  
  2672. procedure TDCPopupDBGrid.DrawClientRect;
  2673.  var
  2674.   DC: HDC;
  2675.   R, R1, R2: TRect;
  2676.   Rgn: HRGN;
  2677. begin
  2678.   if not FShowHeader then Exit;
  2679.   DC  := GetWindowDC(Handle);
  2680.   Rgn := 0;
  2681.   try
  2682.     GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  2683.  
  2684.     R2 := R;
  2685.     with FMargins do
  2686.     begin
  2687.      InflateRect(R2, -2, -2);
  2688.      R2.Top := R2.Top + br_HeaderHeight;
  2689.      R2.Bottom := R2.Bottom - br_FooterHeight;
  2690.     end;
  2691.  
  2692.     Rgn := CreateRectRgn(R2.Left, R2.Top, R2.Right, R2.Bottom);
  2693.     SelectClipRgn(DC, Rgn);
  2694.  
  2695.     R1 := Rect(FMargins.Left, FMargins.Top, R.Right-FMargins.Right, R.Bottom-FMargins.Bottom);
  2696.     InflateRect(R1, -1, -1);
  2697.  
  2698.     DrawEdge(DC, R1, BDR_SUNKENOUTER, BF_TOPLEFT);
  2699.     DrawEdge(DC, R1, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
  2700.  
  2701.     ExcludeClipRect(DC, R1.Left, R1.Top, R1.Right, R1.Bottom);
  2702.     FillRect(DC, R,  GetSysColorBrush(clWhite));
  2703.  
  2704.   finally
  2705.     ReleaseDC(Handle, DC);
  2706.     if Rgn <> 0 then DeleteObject(Rgn);
  2707.   end;
  2708. end;
  2709.  
  2710. function TDCPopupDBGrid.ValidPosition: boolean;
  2711. begin
  2712.  try
  2713.    Result := (TPrivateDataSet(DataSource.DataSet).BookmarkSize > 0) and
  2714.      DataSource.DataSet.BookmarkValid(Position)
  2715.  except
  2716.    Result := False;
  2717.  end;
  2718. end;
  2719.  
  2720. { TDCPopupTreeView }
  2721.  
  2722. procedure TDCPopupTreeView.AdjustNewHeight;
  2723. var
  2724.   DC: HDC;
  2725.   SaveFont: HFONT;
  2726.   Metrics: TTextMetric;
  2727. begin
  2728.   DC := GetDC(0);
  2729.   SaveFont := SelectObject(DC, Font.Handle);
  2730.   try
  2731.     GetTextMetrics (DC, Metrics);
  2732.     FItemHeight := Metrics.tmHeight;
  2733.     FItemHeight := FItemHeight + 3;
  2734.   finally
  2735.     SelectObject(DC, SaveFont);
  2736.     ReleaseDC(0, DC);
  2737.   end;
  2738. end;
  2739.  
  2740. procedure TDCPopupTreeView.BeginMoving(XCursor, YCursor: integer);
  2741. begin
  2742.   ProcessMovingWindow(Self, XCursor, YCursor, FCursorMode, FItemHeight);
  2743. end;
  2744.  
  2745. procedure TDCPopupTreeView.CMMouseEnter(var Message: TMessage);
  2746. begin
  2747.   inherited;
  2748.   if Assigned(FButtons) then
  2749.     FButtons.MouseDown := GetAsyncKeyState(VK_LBUTTON)<0;
  2750. end;
  2751.  
  2752. procedure TDCPopupTreeView.CMMouseLeave(var Message: TMessage);
  2753. begin
  2754.   inherited;
  2755.   if Assigned(FButtons) then
  2756.     FButtons.UpdateButtons( -1, -1, False, True);
  2757. end;
  2758.  
  2759. procedure TDCPopupTreeView.CMSetAlignment(var Message: TMessage);
  2760. begin
  2761.   PopupAlignment := TWindowAlignment(Message.WParam);
  2762. end;
  2763.  
  2764. constructor TDCPopupTreeView.Create(AOwner: TComponent);
  2765. begin
  2766.   inherited Create(AOwner);
  2767.   FVisible    := False;
  2768.  
  2769.   ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable,
  2770.                                   csAcceptsControls, csOpaque];
  2771.   Visible := False;
  2772.  
  2773.   Canvas.Brush.Style := bsClear;
  2774.   FAlwaysVisible := True;
  2775.   FOwner := TControl(AOwner);
  2776.  
  2777.   SetRectEmpty(FWindowRect);
  2778.   SetRectEmpty(FMargins);
  2779.   FDropDownRows := 10;
  2780.  
  2781.   AdjustNewHeight;
  2782.  
  2783.   BorderStyle := bsNone;
  2784.  
  2785.   FCursorMode := cmNone;
  2786.   FButtons := TDCEditButtons.Create(Self);
  2787.   FButtons.AnchorStyle := asBL;
  2788.   FButtons.Color := clBtnFace;
  2789.   FButtons.OnlyClientRepaint := True;
  2790.  
  2791.   ReadOnly    := True;
  2792.   FShowHeader := True;
  2793. end;
  2794.  
  2795. procedure TDCPopupTreeView.CreateParams(var Params: TCreateParams);
  2796. begin
  2797.   inherited CreateParams(Params);
  2798.   with Params do
  2799.   begin
  2800.     ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST or WS_EX_CONTROLPARENT;
  2801.     Style   := Style and not(WS_HSCROLL or WS_VSCROLL) or WS_CLIPCHILDREN;
  2802.   end;
  2803. end;
  2804.  
  2805. procedure TDCPopupTreeView.CreateWnd;
  2806. begin
  2807.   if Parent <> nil then
  2808.   begin
  2809.     inherited CreateWnd;
  2810.     Windows.SetParent(Handle, 0);
  2811.     CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
  2812.     SetMargins;
  2813.   end;
  2814. end;
  2815.  
  2816. destructor TDCPopupTreeView.Destroy;
  2817. begin
  2818.   FButtons.Free;
  2819.   FButtons := nil;
  2820.   inherited;
  2821. end;
  2822.  
  2823. procedure TDCPopupTreeView.DrawClientRect;
  2824.  var
  2825.   DC: HDC;
  2826.   R, R1, R2: TRect;
  2827.   Rgn: HRGN;
  2828. begin
  2829.   if not FShowHeader then Exit;
  2830.   DC  := GetWindowDC(Handle);
  2831.   Rgn := 0;
  2832.   try
  2833.     GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  2834.  
  2835.     R2 := R;
  2836.     with FMargins do
  2837.     begin
  2838.      InflateRect(R2, -2, -2);
  2839.      R2.Top := R2.Top + br_HeaderHeight;
  2840.      R2.Bottom := R2.Bottom - br_FooterHeight;
  2841.     end;
  2842.  
  2843.     Rgn := CreateRectRgn(R2.Left, R2.Top, R2.Right, R2.Bottom);
  2844.     SelectClipRgn(DC, Rgn);
  2845.  
  2846.     R1 := Rect(FMargins.Left, FMargins.Top, R.Right-FMargins.Right, R.Bottom-FMargins.Bottom);
  2847.     R1 := Rect(FMargins.Left, FMargins.Top, R.Right-FMargins.Right, R.Bottom-FMargins.Bottom);
  2848.     InflateRect(R1, -1, -1);
  2849.  
  2850.     DrawEdge(DC, R1, BDR_SUNKENOUTER, BF_TOPLEFT);
  2851.     DrawEdge(DC, R1, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
  2852.  
  2853.     ExcludeClipRect(DC, R1.Left, R1.Top, R1.Right, R1.Bottom);
  2854.     FillRect(DC, R,  GetSysColorBrush(clWhite));
  2855.   finally
  2856.     ReleaseDC(Handle, DC);
  2857.     if Rgn <> 0 then DeleteObject(Rgn);
  2858.   end;
  2859. end;
  2860.  
  2861. procedure TDCPopupTreeView.DrawFooter;
  2862.  var
  2863.   DC: HDC;
  2864.   R: TRect;
  2865.   Bitmap: TBitmap;
  2866. begin
  2867.   if not FShowHeader then Exit;
  2868.   DC := GetWindowDC(Handle);
  2869.   Bitmap := TBitmap.Create;
  2870.   try
  2871.     GetWindowRect (Handle, R); OffsetRect (R, -R.Left, -R.Top);
  2872.     InflateRect(R, -2, -2);
  2873.     Bitmap.Canvas.Brush.Color := COLOR_BTNFACE;
  2874.     Bitmap.LoadFromResourceName(HInstance, 'DC_BTNSIZE');
  2875.     R.Top := R.Bottom - br_FooterHeight - 4;
  2876.     FillRect(DC, R,  GetSysColorBrush(COLOR_BTNFACE));
  2877.     R.Left := R.Right-Bitmap.Width-2;
  2878.     R.Top  := R.Bottom-Bitmap.Height-2;
  2879.     DrawTransparentBitmap(DC, Bitmap, R, False, Bitmap.Canvas.Pixels[0,0]);
  2880.   finally
  2881.     Bitmap.Free;
  2882.     ReleaseDC(Handle, DC);
  2883.   end;
  2884. end;
  2885.  
  2886. procedure TDCPopupTreeView.DrawHeader;
  2887.  var
  2888.   DC: HDC;
  2889.   R: TRect;
  2890. begin
  2891.   if not FShowHeader then Exit;
  2892.   DC := GetWindowDC(Handle);
  2893.   try
  2894.     GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  2895.     InflateRect(R, -2, -2);
  2896.     R.Bottom := R.Top + br_HeaderHeight;
  2897.     FillRect(DC, R,  GetSysColorBrush(COLOR_BTNFACE));
  2898.     R.Bottom := R.Bottom - 1;
  2899.     DrawCaption(Handle, DC, R, DC_TEXT or DC_SMALLCAP or DC_ACTIVE or DC_GRADIENT);
  2900.   finally
  2901.     ReleaseDC(Handle, DC);
  2902.   end;
  2903. end;
  2904.  
  2905. procedure TDCPopupTreeView.Hide;
  2906. begin
  2907.   FButtons.ClrWndProc;
  2908.   HideWindow(Handle);
  2909.   FVisible := False;
  2910. end;
  2911.  
  2912. procedure TDCPopupTreeView.InvalidateButtons;
  2913.  var
  2914.   i, RightPos: integer;
  2915.   Button: TDCEditButton;
  2916.   Changed: boolean;
  2917. begin
  2918.   RightPos := Width-br_SizerWidth-FBorderSize-FMargins.Left-3;
  2919.   Changed  := False;
  2920.   for i := 0 to FButtons.Count-1 do
  2921.   begin
  2922.     Button := FButtons.Buttons[i];
  2923.     if (Button.Left+Button.Width) > RightPos then
  2924.     begin
  2925.       if Button.Visible then
  2926.       begin
  2927.         Button.Visible := False;
  2928.         Changed := True;
  2929.       end
  2930.     end
  2931.     else
  2932.       if not Button.Visible then
  2933.       begin
  2934.         Button.Visible := True;
  2935.         Changed := True;
  2936.       end;
  2937.   end;
  2938.  if Changed then
  2939.      SendMessage(Self.Handle, WM_NCPAINT, 0, 0);
  2940. end;
  2941.  
  2942. procedure TDCPopupTreeView.KeyDown(var Key: Word; Shift: TShiftState);
  2943. begin
  2944.   inherited;
  2945.   case Key of
  2946.     VK_LEFT :
  2947.       begin
  2948.         if ssCtrl in Shift then
  2949.           SetBounds(Left-POPUP_MOVE_STEPX, Top, Width, Height);
  2950.       end;
  2951.     VK_RIGHT:
  2952.       begin
  2953.         if ssCtrl in Shift then
  2954.           SetBounds(Left+POPUP_MOVE_STEPX, Top, Width, Height);
  2955.       end;
  2956.     VK_UP   :
  2957.       begin
  2958.         if ssCtrl in Shift then
  2959.           SetBounds(Left, Top-POPUP_MOVE_STEPY, Width, Height);
  2960.       end;
  2961.     VK_DOWN :
  2962.       begin
  2963.         if ssCtrl in Shift then
  2964.           SetBounds(Left, Top+POPUP_MOVE_STEPY, Width, Height);
  2965.       end;
  2966.   end;
  2967. end;
  2968.  
  2969. procedure TDCPopupTreeView.KeyPress(var Key: Char);
  2970. begin
  2971.   case Key of
  2972.     '+':
  2973.       if Selected <> nil then
  2974.       begin
  2975.         Self.Items.BeginUpdate;
  2976.         try
  2977.           Selected.Expand(False);
  2978.         finally
  2979.           Self.Items.EndUpdate;
  2980.         end;
  2981.       end;
  2982.     '-':
  2983.       if Selected <> nil then
  2984.       begin
  2985.         Self.Items.BeginUpdate;
  2986.         try
  2987.           Selected.Collapse(False);
  2988.         finally
  2989.           Self.Items.EndUpdate;
  2990.         end;
  2991.       end;
  2992.     '*':
  2993.       begin
  2994.         Self.Items.BeginUpdate;
  2995.         try
  2996.           FullExpand;
  2997.         finally
  2998.           Self.Items.EndUpdate;
  2999.         end;
  3000.       end;
  3001.   end;
  3002. end;
  3003.  
  3004. procedure TDCPopupTreeView.RedrawBorder;
  3005.  var
  3006.   DC: HDC;
  3007.   R: TRect;
  3008.   ABrush: HBRUSH;
  3009. begin
  3010.   if not ShowScrollBar(Handle, SB_HORZ, False) then Exit;
  3011.   DC := GetWindowDC(Handle);
  3012.   try
  3013.     GetWindowRect(Handle, R);  OffsetRect(R, -R.Left, -R.Top);
  3014.  
  3015.     case FPopupBorderStyle of
  3016.       brNone:;
  3017.       brSingle:
  3018.         begin 
  3019.           ABrush := CreateSolidBrush(clBlack);
  3020.           FrameRect( DC, R, ABrush);
  3021.           DeleteObject(ABrush);
  3022.         end;
  3023.       brRaised:
  3024.         begin
  3025.           DrawEdge(DC, R, BDR_RAISEDOUTER, BF_RECT);
  3026.           InflateRect(R, -1, -1);
  3027.           DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT);
  3028.  
  3029.           DrawHeader;
  3030.           DrawClientRect;
  3031.           DrawFooter;
  3032.         end;
  3033.     end;
  3034.   finally
  3035.     ReleaseDC(Handle, DC);
  3036.   end;
  3037. end;
  3038.  
  3039. procedure TDCPopupTreeView.SetBounds(ALeft, ATop, AWidth,
  3040.   AHeight: Integer);
  3041. begin
  3042.   if AHeight < FItemHeight*5 then AHeight := FItemHeight*5;
  3043.   if AWidth  < 80 then AWidth  := 80;
  3044.   inherited;
  3045.   FWindowRect := Rect(Left,Top,Left+Width,Top+Height);
  3046. end;
  3047.  
  3048. procedure TDCPopupTreeView.SetBoundsEx(ALeft, ATop, AWidth,
  3049.   AHeight: Integer);
  3050. begin
  3051.   FWindowRect := Rect(ALeft,ATop,ALeft+AWidth,aTop+AHeight);
  3052.   if FVisible then Show;
  3053. end;
  3054.  
  3055. procedure TDCPopupTreeView.SetMargins;
  3056. begin
  3057.   FMargins := Rect(4,4,4,2);
  3058.   if not FShowHeader then Exit;
  3059.   case FPopupBorderStyle of
  3060.     brNone  :;
  3061.     brSingle:;
  3062.     brRaised:
  3063.       begin
  3064.         // Margins.Properties
  3065.         FMargins.Top    := FMargins.Top + br_HeaderHeight;
  3066.         FMargins.Bottom := FMargins.Bottom + br_FooterHeight+4;
  3067.       end;
  3068.   end;
  3069. end;
  3070.  
  3071. procedure TDCPopupTreeView.SetParent(AParent: TWinControl);
  3072. begin
  3073.   inherited;
  3074. end;
  3075.  
  3076. procedure TDCPopupTreeView.SetPopupAlignment(Value: TWindowAlignment);
  3077. begin
  3078.   if Value <> FPopupAlignment then
  3079.   begin
  3080.     FPopupAlignment := Value;
  3081.     if Visible then Show;
  3082.   end;
  3083. end;
  3084.  
  3085. procedure TDCPopupTreeView.SetPopupBorderStyle(Value: TPopupBorderStyle);
  3086. begin
  3087.   if FPopupBorderStyle <> Value then
  3088.   begin
  3089.     FPopupBorderStyle := Value;
  3090.     case FPopupBorderStyle of
  3091.       brNone  :FBorderSize := 0;
  3092.       brSingle:FBorderSize := 1;
  3093.       brRaised:FBorderSize := 2;
  3094.     end;
  3095.     RecreateWnd;
  3096.   end;
  3097. end;
  3098.  
  3099. procedure TDCPopupTreeView.SetShowHeader(const Value: boolean);
  3100. begin
  3101.   FShowHeader := Value;
  3102.   RecreateWnd;
  3103. end;
  3104.  
  3105. procedure TDCPopupTreeView.Show;
  3106. begin
  3107.   SetMargins;
  3108.   Height := FItemHeight*FDropDownRows + 2*FBorderSize + FMargins.Top + FMargins.Bottom;
  3109.   ShowWindow(Handle, FPopupAlignment, FWindowRect, FAlwaysVisible, Owner);
  3110.   FVisible :=  True;
  3111. end;
  3112.  
  3113. procedure TDCPopupTreeView.WMActivate(var Message: TWMActivate);
  3114.  var
  3115.   ParentForm: TCustomForm;
  3116. begin
  3117.   inherited;
  3118.   ParentForm := GetParentForm(Self);
  3119.   if Assigned(ParentForm) and ParentForm.HandleAllocated then
  3120.   begin
  3121.     SendMessage (ParentForm.Handle, WM_NCACTIVATE, Ord(Message.Active <> WA_INACTIVE), 0);
  3122.     if Message.ActiveWindow <> ParentForm.Handle then
  3123.       SetActiveWindow (ParentForm.Handle);
  3124.   end;
  3125. end;
  3126.  
  3127. procedure TDCPopupTreeView.WMFontChange(var Message: TWMFontChange);
  3128.  var
  3129.   i: integer;
  3130. begin
  3131.   inherited;
  3132.   AdjustNewHeight;
  3133.   for i := 0 to FButtons.Count-1 do
  3134.     FButtons.Buttons[i].Font := Font;
  3135. end;
  3136.  
  3137. procedure TDCPopupTreeView.WMHScroll(var Message: TWMHScroll);
  3138. begin
  3139.   inherited;
  3140. end;
  3141.  
  3142. procedure TDCPopupTreeView.WMLButtonDblClk(var Message: TWMLButtonDown);
  3143.  var
  3144.   HitTest: THitTests;
  3145. begin
  3146.   HitTest := GetHitTestInfoAt(Message.XPos, Message.YPos);
  3147.   if not(htOnButton in HitTest) then
  3148.   begin
  3149.     SendMessage(TWinControl(FOwner).Handle, Message.Msg, $AE, TMessage(Message).LParam);
  3150.     Message.Msg    := 0;
  3151.     inherited;
  3152.   end
  3153.   else
  3154.     Perform(WM_LBUTTONDOWN, TMessage(Message).WParam, TMessage(Message).LParam);
  3155. end;
  3156.  
  3157. procedure TDCPopupTreeView.WMMouseActivate(var Message: TWMActivate);
  3158. begin
  3159.   inherited;
  3160.   Message.Result := MA_NOACTIVATE;
  3161.   SetWindowPos (Handle, HWND_TOP, 0, 0, 0, 0,
  3162.      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  3163. end;
  3164.  
  3165. procedure TDCPopupTreeView.WMNCCalcSize(var Message: TWMNCCalcSize);
  3166. begin
  3167.   case FPopupBorderStyle of
  3168.     brNone  :FBorderSize := 0;
  3169.     brSingle:
  3170.       begin
  3171.         FBorderSize := 2;
  3172.         InflateRect(Message.CalcSize_Params^.rgrc[0], -2, -2);
  3173.       end;
  3174.     brRaised:
  3175.       begin
  3176.         FBorderSize := 2;
  3177.         InflateRect(Message.CalcSize_Params^.rgrc[0], -2, -2);
  3178.       end;
  3179.   end;
  3180.   with Message.CalcSize_Params^.rgrc[0] do
  3181.   begin
  3182.     Top    := Top    + FMargins.Top;
  3183.     Left   := Left   + FMargins.Left;
  3184.     Bottom := Bottom - FMargins.Bottom;
  3185.     Right  := Right  - FMargins.Right;
  3186.   end;
  3187.  
  3188.   inherited;
  3189. end;
  3190.  
  3191. procedure TDCPopupTreeView.WMNCHitTest(var Message: TWMNCHitTest);
  3192.  var
  3193.   R, WindowR: TRect;
  3194.   BS: Integer;
  3195.   Button: TDCEditButton;
  3196.  function InCaptArea(XPos, YPos: integer): boolean;
  3197.  begin
  3198.    R := WindowR;
  3199.    InflateRect(R, -BS, -BS);
  3200.    R.Bottom := R.Top + FMargins.Top;
  3201.    Result := PtInRect(R, Point(XPos, YPos));
  3202.  end;
  3203.  function InSizeArea(XPos, YPos: integer): boolean;
  3204.  begin
  3205.    R := WindowR;
  3206.    InflateRect(R, -BS, -BS);
  3207.    R.Top  := R.Bottom - br_FooterHeight;
  3208.    R.Left := R.Right  - br_SizerWidth;
  3209.    Result := PtInRect(R, Point(XPos, YPos));
  3210.  end;
  3211.  function InGridArea(XPos, YPos: integer): boolean;
  3212.  begin
  3213.    R := WindowR;
  3214.    InflateRect(R, -BS, -BS);
  3215.    R.Left   := R.Left   + FMargins.Left;
  3216.    R.Top    := R.Top    + FMargins.Top;
  3217.    R.Right  := R.Right  - FMargins.Right;
  3218.    R.Bottom := R.Bottom - FMargins.Bottom;
  3219.    Result := PtInRect(R, Point(XPos, YPos));
  3220.  end;
  3221.  function InButtonsArea(XPos, YPos: integer): boolean;
  3222.   var
  3223.    P: TPoint;
  3224.  begin
  3225.    P.X := XPos - Left;
  3226.    P.Y := YPos - Top;
  3227.    Result := FButtons.MouseInButtonArea(P.X, P.Y, Button);
  3228.    R := WindowR;
  3229.    InflateRect(R, -BS, -BS);
  3230.  end;
  3231.  function InFooterArea(XPos, YPos: integer): boolean;
  3232.  begin
  3233.    R := WindowR;
  3234.    InflateRect(R, -BS, -BS);
  3235.    R.Top  := R.Bottom - br_FooterHeight;
  3236.    Result := PtInRect(R, Point(XPos, YPos));
  3237.  end;
  3238. begin
  3239.   inherited;
  3240.   if not FShowHeader then begin
  3241.     FCursorMode := cmGrid;
  3242.     Exit;
  3243.   end;
  3244.   FCursorMode := cmNone;
  3245.   BS := FBorderSize;
  3246.   GetWindowRect(Handle, WindowR);
  3247.   with Message do
  3248.   begin
  3249.     if InCaptArea(XPos, YPos) then
  3250.     begin
  3251.       FCursorMode := cmMove;
  3252.       Result := HTBORDER;
  3253.     end;
  3254.  
  3255.     if InFooterArea(XPos, YPos) then
  3256.     begin
  3257.       FCursorMode := cmFooter;
  3258.       Result := HTBORDER;
  3259.     end;
  3260.  
  3261.     if InSizeArea(XPos, YPos) then
  3262.     begin
  3263.       FCursorMode := cmResize;
  3264.       Result := HTSIZE;
  3265.     end;
  3266.     if InGridArea(XPos, YPos) then FCursorMode := cmGrid;
  3267.  
  3268.     if InButtonsArea(XPos, YPos) then
  3269.     begin
  3270.       FCursorMode := cmButtons;
  3271.       Result := HTBORDER;
  3272.     end;
  3273.   end;
  3274. end;
  3275.  
  3276. procedure TDCPopupTreeView.WMNCLButtonDown(var Message: TWMNCLButtonDown);
  3277. begin
  3278.   inherited;
  3279.   with Message do
  3280.   begin
  3281.     case FCursorMode of
  3282.       cmResize: BeginMoving(XCursor, YCursor);
  3283.       cmMove  : BeginMoving(XCursor, YCursor);
  3284.     end;
  3285.   end;
  3286. end;
  3287.  
  3288. procedure TDCPopupTreeView.WMNCPaint(var Message: TWMNCPaint);
  3289. begin
  3290.   ShowScrollBar(Handle, SB_HORZ, False);
  3291.   inherited;
  3292.   RedrawBorder;
  3293. end;
  3294.  
  3295. procedure TDCPopupTreeView.WMPaint(var Message: TWMPaint);
  3296. begin
  3297.   if Assigned(FButtons) then FButtons.UpdateDeviceRegion(Message.DC);
  3298.   inherited;
  3299.   if Assigned(FButtons) then InvalidateButtons;
  3300. end;
  3301.  
  3302. procedure TDCPopupTreeView.WMSetCursor(var Message: TWMSetCursor);
  3303. begin
  3304.   case FCursorMode of
  3305.     cmNone   : SetCursor(Screen.Cursors[crArrow]);
  3306.     cmResize : SetCursor(Screen.Cursors[crSizeNWSE]);
  3307.     cmMove   : SetCursor(Screen.Cursors[crArrow]);
  3308.     cmButtons: SetCursor(Screen.Cursors[crArrow]);
  3309.     cmFooter : SetCursor(Screen.Cursors[crArrow]);
  3310.     cmGrid   : inherited;
  3311.   end;
  3312. end;
  3313.  
  3314. procedure TDCPopupTreeView.WMShowWindow(var Message: TWMShowWindow);
  3315. begin
  3316.   inherited;
  3317. end;
  3318.  
  3319. procedure TDCPopupTreeView.WMSize(var Message: TWMSize);
  3320. begin
  3321.   inherited;
  3322.   if Assigned(FButtons) then InvalidateButtons;
  3323. end;
  3324.  
  3325. { TDCClipPopup }
  3326.  
  3327. procedure TDCClipPopup.BeginMoving(XCursor, YCursor, Delta: integer);
  3328. begin
  3329.   ProcessMovingWindow(Self, XCursor, YCursor, FCursorMode, Delta);
  3330. end;
  3331.  
  3332. procedure TDCClipPopup.CMSetAlignment(var Message: TMessage);
  3333. begin
  3334.   PopupAlignment := TWindowAlignment(Message.WParam);
  3335. end;
  3336.  
  3337. constructor TDCClipPopup.Create(AOwner: TComponent);
  3338. begin
  3339.   inherited Create(AOwner);
  3340.   SetRectEmpty(FMargins);
  3341.   FCursorMode := cmNone;
  3342.   FButtons := TDCEditButtons.Create(Self);
  3343.   FButtons.AnchorStyle := asNone;
  3344.   FButtons.Color := clBtnFace;
  3345.  
  3346.   FOptions := [];
  3347. end;
  3348.  
  3349. procedure TDCClipPopup.CreateWnd;
  3350. begin
  3351.   inherited;
  3352.   if Parent <> nil then
  3353.   begin
  3354.     FButtons.ClrWndProc;
  3355.     FButtons.SetWndProc;
  3356.   end;
  3357. end;
  3358.  
  3359. destructor TDCClipPopup.Destroy;
  3360. begin
  3361.   FButtons.Free;
  3362.   FButtons := nil;
  3363.   inherited;
  3364. end;
  3365.  
  3366. procedure TDCClipPopup.DrawFooter;
  3367.  var
  3368.   DC: HDC;
  3369.   R: TRect;
  3370.   Bitmap: TBitmap;
  3371. begin
  3372.   if not(coFooter in FOptions) then Exit;
  3373.   DC := GetWindowDC(Handle);
  3374.   Bitmap := TBitmap.Create;
  3375.   try
  3376.     GetWindowRect (Handle, R); OffsetRect (R, -R.Left, -R.Top);
  3377.     InflateRect(R, -2, -2);
  3378.     Bitmap.LoadFromResourceName(HInstance, 'DC_BTNSIZE');
  3379.     R.Top := R.Bottom - FMargins.Bottom;
  3380.     FillRect(DC, R,  GetSysColorBrush(COLOR_BTNFACE));
  3381.     R.Left := R.Right-Bitmap.Width-2;
  3382.     R.Top  := R.Bottom-Bitmap.Height-2;
  3383.     DrawTransparentBitmap(DC, Bitmap, R, False, Bitmap.Canvas.Pixels[0,0]);
  3384.   finally
  3385.     Bitmap.Free;
  3386.     ReleaseDC(Handle, DC);
  3387.   end;
  3388. end;
  3389.  
  3390. procedure TDCClipPopup.DrawHeader;
  3391.  var
  3392.   DC: HDC;
  3393.   R: TRect;
  3394. begin
  3395.   if not(coHeader in FOptions) then Exit;
  3396.   DC := GetWindowDC(Handle);
  3397.   try
  3398.     GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  3399.     InflateRect(R, -2, -2);
  3400.     R.Bottom := R.Top + FMargins.Top;
  3401.     FillRect(DC, R,  GetSysColorBrush(COLOR_BTNFACE));
  3402.     R.Bottom := R.Bottom - 1;
  3403.     DrawCaption(Handle, DC, R, DC_TEXT or DC_SMALLCAP or DC_ACTIVE or DC_GRADIENT);
  3404.   finally
  3405.     ReleaseDC(Handle, DC);
  3406.   end;
  3407. end;
  3408.  
  3409. procedure TDCClipPopup.Hide;
  3410. begin
  3411.   inherited;
  3412. end;
  3413.  
  3414. procedure TDCClipPopup.InvalidateButtons;
  3415. begin
  3416.   {}
  3417. end;
  3418.  
  3419. procedure TDCClipPopup.KeyDown(var Key: Word; Shift: TShiftState);
  3420. begin
  3421.   inherited;
  3422.   if coHeader in FOptions then
  3423.   begin
  3424.     case Key of
  3425.       VK_LEFT :
  3426.         begin
  3427.           if ssCtrl in Shift then
  3428.             SetBounds(Left-POPUP_MOVE_STEPX, Top, Width, Height);
  3429.         end;
  3430.       VK_RIGHT:
  3431.         begin
  3432.           if ssCtrl in Shift then
  3433.             SetBounds(Left+POPUP_MOVE_STEPX, Top, Width, Height);
  3434.         end;
  3435.       VK_UP   :
  3436.         begin
  3437.           if ssCtrl in Shift then
  3438.             SetBounds(Left, Top-POPUP_MOVE_STEPY, Width, Height);
  3439.         end;
  3440.       VK_DOWN :
  3441.         begin
  3442.           if ssCtrl in Shift then
  3443.             SetBounds(Left, Top+POPUP_MOVE_STEPY, Width, Height);
  3444.         end;
  3445.     end;
  3446.   end;
  3447. end;
  3448.  
  3449. procedure TDCClipPopup.RedrawBorder;
  3450.  var
  3451.   DC: HDC;
  3452.   R: TRect;
  3453.   ABrush: HBRUSH;
  3454. begin
  3455.   DC := GetWindowDC(Handle);
  3456.   try
  3457.     GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  3458. //    Canvas.FillRect(R);
  3459.     case FPopupBorderStyle of
  3460.       brNone:;
  3461.       brSingle:
  3462.         begin 
  3463.           ABrush := CreateSolidBrush(clBlack);
  3464.           FrameRect( DC, R, ABrush);
  3465.           DeleteObject(ABrush);
  3466.         end;
  3467.       brRaised:
  3468.         begin
  3469.           DrawEdge(DC, R, BDR_RAISEDOUTER, BF_BOTTOMRIGHT);
  3470.           DrawEdge(DC, R, BDR_SUNKENOUTER, BF_TOPLEFT);
  3471.           InflateRect(R, -1, -1);
  3472.           DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT);
  3473.  
  3474.           DrawHeader;
  3475.           DrawFooter;
  3476.         end;
  3477.     end;
  3478.   finally
  3479.     ReleaseDC(Handle, DC);
  3480.   end;
  3481. end;
  3482.  
  3483. procedure TDCClipPopup.SetMargins;
  3484. begin
  3485.   FMargins := Rect(0,0,0,0);
  3486.   case FPopupBorderStyle of
  3487.     brNone  :;
  3488.     brSingle:;
  3489.     brRaised:
  3490.       begin
  3491.         // Margins.Properties
  3492.         if coHeader in FOptions then FMargins.Top    := 14;
  3493.         if coFooter in FOptions then FMargins.Bottom := br_FooterHeight+4;
  3494.       end;
  3495.   end;
  3496. end;
  3497.  
  3498. procedure TDCClipPopup.SetOptions(const Value: TClipFormOptions);
  3499. begin
  3500.   FOptions := Value;
  3501.   SetMargins;
  3502.   RecreateWnd;
  3503. end;
  3504.  
  3505. procedure TDCClipPopup.SetPopupBorderStyle(Value: TPopupBorderStyle);
  3506. begin
  3507.   if FPopupBorderStyle <> Value then
  3508.   begin
  3509.     FPopupBorderStyle := Value;
  3510.     case FPopupBorderStyle of
  3511.       brNone  :FBorderSize := 0;
  3512.       brSingle:FBorderSize := 1;
  3513.       brRaised:FBorderSize := 2;
  3514.     end;
  3515.     SetMargins;
  3516.     RecreateWnd;
  3517.   end;
  3518. end;
  3519.  
  3520. procedure TDCClipPopup.Show;
  3521. begin
  3522.   FButtons.ResetProperties;
  3523.   SetCapture(Self.Handle);
  3524.   inherited;
  3525. end;
  3526.  
  3527. procedure TDCClipPopup.WMActivate(var Message: TWMActivate);
  3528.  var
  3529.   ParentForm: TCustomForm;
  3530. begin
  3531.   inherited;
  3532.   ParentForm := GetParentForm(Self);
  3533.   if Assigned(ParentForm) and ParentForm.HandleAllocated then
  3534.   begin
  3535.     SendMessage (ParentForm.Handle, WM_NCACTIVATE, Ord(Message.Active <> WA_INACTIVE), 0);
  3536.     if Message.ActiveWindow <> ParentForm.Handle then
  3537.       SetActiveWindow (ParentForm.Handle);
  3538.   end;
  3539. end;
  3540.  
  3541. procedure TDCClipPopup.WMNCCalcSize(var Message: TWMNCCalcSize);
  3542. begin
  3543.   case FPopupBorderStyle of
  3544.     brNone  :FBorderSize := 0;
  3545.     brSingle:
  3546.       begin
  3547.         FBorderSize := 2;
  3548.         InflateRect(Message.CalcSize_Params^.rgrc[0], -2, -2);
  3549.       end;
  3550.     brRaised:
  3551.       begin
  3552.         FBorderSize := 2;
  3553.         InflateRect(Message.CalcSize_Params^.rgrc[0], -2, -2);
  3554.       end;
  3555.   end;
  3556.   with Message.CalcSize_Params^.rgrc[0] do
  3557.   begin
  3558.     Top    := Top    + FMargins.Top;
  3559.     Left   := Left   + FMargins.Left;
  3560.     Bottom := Bottom - FMargins.Bottom;
  3561.     Right  := Right  - FMargins.Right;
  3562.   end;
  3563.   inherited;
  3564. end;
  3565.  
  3566. procedure TDCClipPopup.WMNCHitTest(var Message: TWMNCHitTest);
  3567.  var
  3568.   R, WindowR: TRect;
  3569.   BS: Integer;
  3570.   Button: TDCEditButton;
  3571.  function InCaptArea(XPos, YPos: integer): boolean;
  3572.  begin
  3573.    if not(coHeader in FOptions) then
  3574.    begin
  3575.      Result := False;
  3576.      Exit;
  3577.    end;
  3578.    R := WindowR;
  3579.    InflateRect(R, -BS, -BS);
  3580.    R.Bottom := R.Top + FMargins.Top;
  3581.    Result := PtInRect(R, Point(XPos, YPos));
  3582.  end;
  3583.  function InSizeArea(XPos, YPos: integer): boolean;
  3584.  begin
  3585.    if not(coFooter in FOptions) then
  3586.    begin
  3587.      Result := False;
  3588.      Exit;
  3589.    end;
  3590.    R := WindowR;
  3591.    InflateRect(R, -BS, -BS);
  3592.    R.Top  := R.Bottom - br_FooterHeight;
  3593.    R.Left := R.Right  - br_SizerWidth;
  3594.    Result := PtInRect(R, Point(XPos, YPos));
  3595.  end;
  3596.  function InGridArea(XPos, YPos: integer): boolean;
  3597.  begin
  3598.    R := WindowR;
  3599.    InflateRect(R, -BS, -BS);
  3600.    R.Left   := R.Left   + FMargins.Left;
  3601.    R.Top    := R.Top    + FMargins.Top;
  3602.    R.Right  := R.Right  - FMargins.Right;
  3603.    R.Bottom := R.Bottom - FMargins.Bottom;
  3604.    Result := PtInRect(R, Point(XPos, YPos));
  3605.  end;
  3606.  function InButtonsArea(XPos, YPos: integer): boolean;
  3607.   var
  3608.    P: TPoint;
  3609.  begin
  3610.    P.X := XPos - Left;
  3611.    P.Y := YPos - Top;
  3612.    Result := FButtons.MouseInButtonArea(P.X, P.Y, Button);
  3613.    R := WindowR;
  3614.    InflateRect(R, -BS, -BS);
  3615.  end;
  3616.  function InFooterArea(XPos, YPos: integer): boolean;
  3617.  begin
  3618.    if not(coFooter in FOptions) then
  3619.    begin
  3620.      Result := False;
  3621.      Exit;
  3622.    end;
  3623.    R := WindowR;
  3624.    InflateRect(R, -BS, -BS);
  3625.    R.Top  := R.Bottom - br_FooterHeight;
  3626.    Result := PtInRect(R, Point(XPos, YPos));
  3627.  end;
  3628. begin
  3629.   inherited;
  3630.   FCursorMode := cmNone;
  3631.   BS := FBorderSize;
  3632.   GetWindowRect(Handle, WindowR);
  3633.   with Message do
  3634.   begin
  3635.     if InCaptArea(XPos, YPos) then
  3636.     begin
  3637.       FCursorMode := cmMove;
  3638.       Result := HTBORDER;
  3639.     end;
  3640.  
  3641.     if InFooterArea(XPos, YPos) then
  3642.     begin
  3643.       FCursorMode := cmFooter;
  3644.       Result := HTBORDER;
  3645.     end;
  3646.  
  3647.     if InSizeArea(XPos, YPos) then
  3648.     begin
  3649.       FCursorMode := cmResize;
  3650.       Result := HTSIZE;
  3651.     end;
  3652.     if InGridArea(XPos, YPos) then FCursorMode := cmGrid;
  3653.  
  3654.     if InButtonsArea(XPos, YPos) then
  3655.     begin
  3656.       FCursorMode := cmButtons;
  3657.       Result := HTBORDER;
  3658.     end;
  3659.   end;
  3660. end;
  3661.  
  3662. procedure TDCClipPopup.WMNCLButtonDown(var Message: TWMNCLButtonDown);
  3663. begin
  3664.   inherited;
  3665.   with Message do
  3666.   begin
  3667.     case FCursorMode of
  3668.       cmResize: BeginMoving(XCursor, YCursor, 1);
  3669.       cmMove  : BeginMoving(XCursor, YCursor, 1);
  3670.     end;
  3671.   end;
  3672. end;
  3673.  
  3674. procedure TDCClipPopup.WMNCPaint(var Message: TWMNCPaint);
  3675. begin
  3676.   inherited;
  3677.   RedrawBorder;
  3678. end;
  3679.  
  3680. procedure TDCClipPopup.WMPaint(var Message: TWMPaint);
  3681. begin
  3682.   inherited;
  3683.   InvalidateButtons;
  3684.   RedrawBorder;
  3685. end;
  3686.  
  3687. procedure TDCClipPopup.WMSetCursor(var Message: TWMSetCursor);
  3688. begin
  3689.   case FCursorMode of
  3690.     cmNone   : SetCursor(Screen.Cursors[crArrow]);
  3691.     cmResize : SetCursor(Screen.Cursors[crSizeNWSE]);
  3692.     cmMove   : SetCursor(Screen.Cursors[crArrow]);
  3693.     cmButtons: SetCursor(Screen.Cursors[crArrow]);
  3694.     cmFooter : SetCursor(Screen.Cursors[crArrow]);
  3695.     cmGrid   : inherited;
  3696.   end;
  3697. end;
  3698.  
  3699. procedure TDCClipPopup.WMSize(var Message: TWMSize);
  3700. begin
  3701.   inherited;
  3702.   InvalidateButtons;
  3703. end;
  3704.  
  3705. { TDBClipPopup }
  3706.  
  3707. function TDBClipPopup.AddButton(AName, AResource, AHint: string;
  3708.   ALine, APos: integer): TDCEditButton;
  3709. begin
  3710.   Result := Buttons.AddButtonEx(TDCAssistButton);
  3711.   with TDCAssistButton(Result) do
  3712.   begin
  3713.     Name := AName;
  3714.     Line := ALine;
  3715.     Pos  := APos;
  3716.     BrushColor := clBtnFace;
  3717.     Enabled := Enabled;
  3718.     if AResource <> '' then
  3719.       try
  3720.         Glyph.LoadFromResourceName(HInstance, PChar(AResource));
  3721.       except
  3722.         Glyph.FreeImage;
  3723.       end
  3724.     else
  3725.       Glyph.FreeImage;
  3726.  
  3727.     BrushColor := clWhite;
  3728.     Font := Self.Font;
  3729.     case PopupStyle of
  3730.       cpPopupMenu:
  3731.         begin
  3732.           Caption := AHint;
  3733.           Allignment := abLeft;
  3734.           DrawingStyle := dsXPStyle;
  3735.           SelectColor := clXPSelected;
  3736.           BrushColor := clXPItemBackground;
  3737.         end;
  3738.       cpToolBar:
  3739.         begin
  3740.           Hint := AHint;
  3741.           Allignment := abCenter;
  3742.           OnDrawHint := DrawButtonHint;
  3743.         end;
  3744.     end;
  3745.     OnClick    := ButtonClick;
  3746.     if Line > FLinesCount then FLinesCount := Line;
  3747.     if Pos  > FMaxPos then FMaxPos := Pos;
  3748.   end;
  3749.   if FUpdateCount = 0 then AdjustClipSize;
  3750. end;
  3751.  
  3752. procedure TDBClipPopup.AddButtons;
  3753. begin
  3754.   BeginUpdate;
  3755.   Clear;
  3756.   PopupStyle := cpPopupMenu;
  3757.   AddButton('#Query'   , 'DC_DBQUERY'   , LoadStr(RES_STRN_VAL_QUERY), 0, 0);
  3758.   AddButton('#Property', 'DC_DBPROPERTY', LoadStr(RES_STRN_VAL_PROP) , 0, 1);
  3759.   AddButton('#Find'    , 'DC_DBFIND'    , LoadStr(RES_STRN_VAL_FIND) , 0, 2);
  3760.   AddButton('#Print'   , 'DC_PRINT'     , LoadStr(RES_STRN_VAL_PRINT), 0, 3);
  3761.   EndUpdate;
  3762. end;
  3763.  
  3764. procedure TDBClipPopup.AdjustClipSize;
  3765.  
  3766.   procedure AdjustClipMenuSize;
  3767.    var
  3768.     i, j, k, Y, MaxWidth: integer;
  3769.     Button: TDCAssistButton;
  3770.   begin
  3771.     MaxWidth := 0;
  3772.     k := 30;
  3773.     for i := 0 to Buttons.Count-1 do
  3774.     begin
  3775.       Button := TDCAssistButton(Buttons.Buttons[i]);
  3776.       with Button do
  3777.       begin
  3778.         if Caption <> MenuLineCaption then
  3779.           MaxWidth := _intMax(Button.GetTextSize.X + k + Buttons.MaxImageWidth, MaxWidth);
  3780.       end;
  3781.     end;
  3782.     Y := 0;
  3783.     for i := 0 to Buttons.Count-1 do
  3784.     begin
  3785.       Button := TDCAssistButton(Buttons.Buttons[i]);
  3786.       with Button do
  3787.       begin
  3788.         if Caption = MenuLineCaption then
  3789.           j := 3
  3790.         else
  3791.           j := _intMax(GetTextSize.Y, Button.Glyph.Height + 6);
  3792.         SetBounds( Rect( 3, Margins.Top + 3 + Y, MaxWidth, j));
  3793.         Inc(Y, j);
  3794.       end;
  3795.     end;
  3796.     SetBounds(FWindowRect.Left, FWindowRect.Top, 3*2 + MaxWidth,
  3797.       Margins.Top + 3*2 + Y);
  3798.   end;
  3799.  
  3800.   procedure AdjustToolBarMenuSize;
  3801.    var
  3802.     i, aSize: integer;
  3803.     Button: TDCAssistButton;
  3804.  
  3805.   begin
  3806.     aSize := Buttons.MaxImageWidth + 6;
  3807.     for i := 0 to Buttons.Count-1 do
  3808.     begin
  3809.       Button := TDCAssistButton(Buttons.Buttons[i]);
  3810.       with Button do
  3811.       begin
  3812.         SetBounds( Rect( 3 + Pos * aSize, Margins.Top + 3 + Line * aSize,
  3813.          aSize, aSize));
  3814.       end;
  3815.     end;
  3816.  
  3817.     SetBounds(FWindowRect.Left, FWindowRect.Top, 3*2 + (FMaxPos+1) * aSize,
  3818.       Margins.Top + 3*2 + (FLinesCount+1) * aSize + 2 + FHintHeight);
  3819.   end;
  3820.  
  3821. begin
  3822.   Buttons.UpdateMaxImageWidth;
  3823.   case PopupStyle of
  3824.     cpPopupMenu: AdjustClipMenuSize;
  3825.     cpToolBar: AdjustToolBarMenuSize;
  3826.   end;
  3827. end;
  3828.  
  3829. procedure TDBClipPopup.BeginUpdate;
  3830. begin
  3831.   Inc(FUpdateCount);
  3832. end;
  3833.  
  3834. procedure TDBClipPopup.ButtonClick(Sender: TObject);
  3835. begin
  3836.   inherited;
  3837.   if Assigned(FOnButtonClick) then FOnButtonClick(Sender);
  3838. end;
  3839.  
  3840. procedure TDBClipPopup.Clear;
  3841. begin
  3842.   FButtons.Clear;
  3843.   FLinesCount := 0;
  3844.   FMaxPos := 0;
  3845. end;
  3846.  
  3847. constructor TDBClipPopup.Create(AOwner: TComponent);
  3848.  var
  3849.   P: TPoint;
  3850.   R: TRect;
  3851.  
  3852. begin
  3853.   inherited;
  3854.   Parent := TWinControl(AOwner);
  3855.   R := TPrivateDBGrid(AOwner).CellRect(0,0);
  3856.   P := Point(R.Left, R.Top);
  3857.  
  3858.   FPopupAlignment := wpOffset;
  3859.   FHintHeight  := 18;
  3860.   FLinesCount  := 0;
  3861.   FMaxPos      := 0;
  3862.  
  3863.   Color := clBtnFace;
  3864.  
  3865.   PopupBorderStyle := brRaised;
  3866.   FUpdateCount := 0;
  3867.   FPopupStyle := cpToolBar;
  3868.  
  3869.   SetBounds(P.X, P.Y + R.Bottom - R.Top, 6, 8 + FHintHeight);
  3870. end;
  3871.  
  3872. procedure TDBClipPopup.DrawButtonHint(Sender: TObject; Mode: integer);
  3873.  var
  3874.   sHint: string;
  3875.   R: TRect;
  3876.   DC: HDC;
  3877.   aSize: integer;
  3878. begin
  3879.   if PopupStyle = cpPopupMenu then Exit;
  3880.  
  3881.   if Mode = 0 then
  3882.     sHint := (Sender as TDCEditButton).Hint
  3883.   else
  3884.     sHint := '';
  3885.  
  3886.   aSize := Buttons.MaxImageWidth + 6;
  3887.   R := Rect(2, 2 + (FLinesCount+1) * aSize + 3,
  3888.          Self.Width - 6, 2 + (FLinesCount+1) * aSize + FHintHeight);
  3889.  
  3890.   Canvas.Brush.Color := Color;
  3891.   Canvas.Brush.Style := bsSolid;
  3892.   Canvas.FillRect(R);
  3893.   R.Left:= R.Left+ 2;
  3894.  
  3895.   if sHint <> '' then
  3896.   begin
  3897.     DC := GetWindowDC(Handle);
  3898.     SelectObject(DC, Font.Handle);
  3899.     OffsetRect(R, 0, Margins.Top);
  3900.     if TDCEditButton(Sender).Enabled then
  3901.       SetTextColor(DC, ColorToRGB(Font.Color))
  3902.     else
  3903.       SetTextColor(DC, clShadowed);
  3904.  
  3905.     SetBkMode(DC, TRANSPARENT);
  3906.  
  3907.     DrawText( DC, PChar(sHint), Length(sHint), R,
  3908.               DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS);
  3909.  
  3910.     ReleaseDC(Handle, DC);
  3911.   end;
  3912. end;
  3913.  
  3914. procedure TDBClipPopup.EndUpdate;
  3915. begin
  3916.   Dec(FUpdateCount);
  3917.   if FUpdateCount = 0 then
  3918.   begin
  3919.     AdjustClipSize;
  3920.   end;
  3921. end;
  3922.  
  3923. function TDBClipPopup.GetActiveButton: TDCEditButton;
  3924. begin
  3925.   Result := Buttons.ActiveButton;
  3926. end;
  3927.  
  3928. procedure TDBClipPopup.KeyDown(var Key: Word; Shift: TShiftState);
  3929. begin
  3930.   case Key of
  3931.     VK_LEFT :;
  3932.     VK_RIGHT:;
  3933.   end
  3934. end;
  3935.  
  3936. procedure TDBClipPopup.RedrawBorder;
  3937.  var
  3938.   DC: HDC;
  3939.   R: TRect;
  3940. begin
  3941.   DC := GetWindowDC(Handle);
  3942.   try
  3943.     GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  3944.     DrawEdge(DC, R, BDR_RAISEDOUTER, BF_BOTTOMRIGHT);
  3945.     DrawEdge(DC, R, BDR_SUNKENOUTER, BF_TOPLEFT);
  3946.     InflateRect(R, -1, -1);
  3947.     DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT);
  3948.  
  3949.     DrawHeader;
  3950.     DrawFooter;
  3951.  
  3952.     if PopupStyle <> cpPopupMenu then
  3953.     begin
  3954.       InflateRect(R, -2, -2);
  3955.       R.Top    := R.Bottom - FHintHeight;
  3956.       DrawEdge(DC, R, BDR_SUNKENOUTER, BF_RECT);
  3957.     end;
  3958.   finally
  3959.     ReleaseDC(Handle, DC);
  3960.   end;
  3961. end;
  3962.  
  3963. procedure TDBClipPopup.SetPopupStyle(const Value: TClipPopupStyle);
  3964. begin
  3965.   if FPopupStyle <> Value then
  3966.   begin
  3967.     FPopupStyle := Value;
  3968.     AdjustClipSize;
  3969.   end;
  3970. end;
  3971.  
  3972. { TDCAssistButton }
  3973.  
  3974. procedure TDCAssistButton.BeginDrawBkgn(ACanvas: TCanvas; ARect: TRect;
  3975.   var ImageRect, TextRect: TRect);
  3976. begin
  3977.   ImageRect := GetImageRect;
  3978.   TextRect  := GetTextRect(ImageRect);
  3979.   OffsetRect(ImageRect, ARect.Left, ARect.Top);
  3980.   OffsetRect(TextRect, ARect.Left, ARect.Top);
  3981.  
  3982.   if not Enabled then
  3983.      case DisableStyle of
  3984.        deLite:
  3985.          case DrawingStyle of
  3986.            dsFlat: ACanvas.Brush.Bitmap := AllocPatternBitmap(clLite, clBtnFace);
  3987.            dsXPStyle: ACanvas.Brush.Color := BrushColor;
  3988.          end;
  3989.        deNormal:
  3990.          ACanvas.Brush.Color := BrushColor;
  3991.        deNone:
  3992.          ACanvas.Brush.Color := BrushColor;
  3993.      end
  3994.   else
  3995.     case ButtonState of
  3996.       btRest:
  3997.         ACanvas.Brush.Color := BrushColor;
  3998.       btDownMouseInRect:
  3999.         ACanvas.Brush.Color := DropDownColor;
  4000.       btRestMouseInRect:
  4001.         ACanvas.Brush.Color := SelectColor;
  4002.     end;
  4003. end;
  4004.  
  4005. procedure TDCAssistButton.BeginDrawText(ACanvas: TCanvas; ATextRect: TRect);
  4006.  
  4007.  function LightColor(i: integer): boolean;
  4008.   var
  4009.    j: integer;
  4010.  begin
  4011.    j := ColorToRGB(clLightBarrier);
  4012.    Result := (GetRValue(i) >= GetRValue(j)) and (GetGValue(i) >= GetGValue(j)) and
  4013.      (GetBValue(i) >= GetBValue(j));
  4014.  end;
  4015.  
  4016. begin
  4017.   with ACanvas do
  4018.   begin
  4019.     case ButtonState of
  4020.       btRest:;
  4021.       btDownMouseInRect:
  4022.         if LightColor(DropDownColor) then
  4023.           Font.Color := clWindowText
  4024.         else
  4025.           Font.Color := clHighlightText;
  4026.       btRestMouseInRect:
  4027.         if LightColor(SelectColor) then
  4028.           Font.Color := clWindowText
  4029.         else
  4030.           Font.Color := clHighlightText;
  4031.     end;
  4032.   end;
  4033. end;
  4034.  
  4035. constructor TDCAssistButton.Create(AOwner: TComponent);
  4036. begin
  4037.   inherited;
  4038.   Style := stFlat;
  4039.   FDrawingStyle := dsFlat;
  4040.   SelectColor := clHighlight;
  4041.   FDropDownColor := clXPDropDown;
  4042. end;
  4043.  
  4044. procedure TDCAssistButton.DrawBitmap(ACanvas: TCanvas; ImageRect: TRect);
  4045.  var
  4046.   Offs: TPoint;
  4047.   R, AImageRect: TRect;
  4048.   ABitmap: TBitmap;
  4049.  
  4050.   procedure CopyImage(Canvas: TCanvas; Rect: TRect);
  4051.   begin
  4052.     if AsignedImages then
  4053.       Images.Draw(Canvas, Rect.Left, Rect.Top, ImageIndex, True)
  4054.     else
  4055.       Canvas.StretchDraw(Rect, Glyph);
  4056.   end;
  4057.  
  4058. begin
  4059.   AImageRect := ImageRect;
  4060.   Offs := GetImageOffset;
  4061.   OffsetRect(AImageRect, Offs.X, Offs.Y);
  4062.   if Enabled or (DisableStyle = deNone) then
  4063.   begin
  4064.     if (DrawingStyle = dsXPStyle) and (ButtonState = btRestMouseInRect) then
  4065.     begin
  4066.       ABitmap := TBitmap.Create;
  4067.       try
  4068.         Inc(AImageRect.Right,1);
  4069.         R := AImageRect;
  4070.  
  4071.         ABitmap.Width := AImageRect.Right - AImageRect.Left;
  4072.         ABitmap.Height := AImageRect.Bottom - AImageRect.Top;
  4073.         OffsetRect(R, -R.Left, -R.Top);
  4074.  
  4075.         ABitmap.Canvas.Brush.Color := clFuchsia;
  4076.         ABitmap.Canvas.FillRect(R);
  4077.  
  4078.         CopyImage(ABitmap.Canvas, R);
  4079.  
  4080.         TransformBitmap(ABitmap, ABitmap, tsXPStyle);
  4081.         DrawTransparentBitmap(ACanvas.Handle, ABitmap, AImageRect, False);
  4082.       finally
  4083.         ABitmap.Free;
  4084.       end;
  4085.     end
  4086.     else
  4087.       CopyImage(ACanvas, AImageRect);
  4088.   end
  4089.   else begin
  4090.     case DisableStyle of
  4091.       deLite  : DrawLiteDisableBitmap(ACanvas, ImageRect);
  4092.       deNormal: DrawNormDisableBitmap(ACanvas, ImageRect);
  4093.       deTrans : DrawTranDisableBitmap(ACanvas, ImageRect);
  4094.     end
  4095.   end;
  4096. end;
  4097.  
  4098. procedure TDCAssistButton.DrawBkgnd(ACanvas: TCanvas; ARect: TRect);
  4099.  var
  4100.   R, IR: TRect;
  4101.   Brush: HBRUSH;
  4102. begin
  4103.   case DrawingStyle of
  4104.     dsFlat: inherited DrawBkgnd(ACanvas, ARect);
  4105.     dsXPStyle:
  4106.       begin
  4107.         if ButtonState = btRest then
  4108.         begin
  4109.           IR := GetImageRect;
  4110.           if Caption = MenuLineCaption then
  4111.             if OwnerButtons <> nil then
  4112.               Inc(IR.Right, OwnerButtons.MaxImageWidth)
  4113.             else
  4114.           else
  4115.             IR.Right := IR.Left + OwnerButtons.MaxImageWidth;
  4116.           R := ARect;
  4117.           R.Right := R.Left + IR.Right + 4;
  4118.           Brush := CreateSolidBrush(clXPImageBackground);
  4119.           try
  4120.             FillRect(ACanvas.Handle, R, Brush);
  4121.             ARect.Left := R.Right;
  4122.           finally
  4123.             DeleteObject(Brush);
  4124.           end;
  4125.         end;
  4126.         inherited DrawBkgnd(ACanvas, ARect);
  4127.         if Caption = MenuLineCaption then
  4128.         begin
  4129.           ACanvas.Brush.Color := clXPImageBackground;
  4130.           Inc(ARect.Left, GetTextOffset.X);
  4131.           InflateRect(ARect, 0, -1);
  4132.           FillRect(ACanvas.Handle, ARect, ACanvas.Brush.Handle);
  4133.         end;
  4134.       end;
  4135.   end;
  4136. end;
  4137.  
  4138. procedure TDCAssistButton.DrawBorder(ACanvas: TCanvas; ARect: TRect);
  4139.  var
  4140.   AButtonState: TButtonState;
  4141.   Brush: HBRUSH;
  4142. begin
  4143.   AButtonState := ButtonState;
  4144.   if not Enabled then AButtonState := btRest;
  4145.  
  4146.   case DrawingStyle of
  4147.     dsFlat:
  4148.       begin
  4149.         FrameRect(ACanvas.Handle, ARect, GetSysColorBrush(COLOR_BTNFACE));
  4150.         InflateRect(ARect, -1, -1);
  4151.         FrameRect(ACanvas.Handle, ARect, GetSysColorBrush(COLOR_BTNSHADOW));
  4152.       end;
  4153.     dsXPStyle:
  4154.       case AButtonState of
  4155.         btDownMouseInRect, btRestMouseInRect:
  4156.           begin
  4157.             Brush := CreateSolidBrush(clXPBorder);
  4158.             FrameRect(ACanvas.Handle, ARect, Brush);
  4159.             DeleteObject(Brush);
  4160.           end;
  4161.       end;
  4162.   end;
  4163. end;
  4164.  
  4165. function TDCAssistButton.GetImageOffset: TPoint;
  4166. begin
  4167.   case DrawingStyle of
  4168.     dsFlat: Result := Point(0, 0);
  4169.     dsXPStyle: Result := Point(0, 0);
  4170.   end;
  4171. end;
  4172.  
  4173. function TDCAssistButton.GetTextOffset: TPoint;
  4174. begin
  4175.   case DrawingStyle of
  4176.     dsFlat: Result := Point(0, 0);
  4177.     dsXPStyle: Result := Point(7, 0);
  4178.   end;
  4179. end;
  4180.  
  4181. function TDCAssistButton.OneClickButton: boolean;
  4182. begin
  4183.   Result := True;
  4184. end;
  4185.  
  4186. procedure TDCAssistButton.SetDrawingStyle(const Value: TDCDrawingStyle);
  4187. begin
  4188.   FDrawingStyle := Value;
  4189. end;
  4190.  
  4191. procedure TDCAssistButton.SetLine(const Value: integer);
  4192. begin
  4193.   if FLine <> Value then
  4194.   begin
  4195.     FLine := Value;
  4196.   end;
  4197. end;
  4198.  
  4199. procedure TDCAssistButton.SetPos(const Value: integer);
  4200. begin
  4201.   if FPos <> Value then
  4202.   begin
  4203.     FPos := Value;
  4204.   end;
  4205. end;
  4206.  
  4207. end.
  4208.  
  4209.