home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d456 / DCSLIB25.ZIP / DCChecklst.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-25  |  41.7 KB  |  1,549 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 DCChecklst;
  10.  
  11. interface
  12. {$I DCConst.inc}
  13.  
  14. uses
  15.   Windows, Messages, SysUtils, Classes, Controls, Forms, Graphics, StdCtrls,
  16.   Dialogs, CheckLst, DCEditButton, DCConst, DCChoice;
  17.  
  18. type
  19.   TSetTextEvent = procedure (Sender: TObject; Value: string) of object;
  20.  
  21.   TDCPopupCheckListBox = class(TCheckListBox)
  22.   private
  23.     FButtons: TDCEditButtons;
  24.     FVisible: boolean;
  25.     FOwner: TControl;
  26.     FWindowRect: TRect;
  27.     FAlwaysVisible: boolean;
  28.     FPopupAlignment: TWindowAlignment;
  29.     FPopupBorderStyle: TPopupBorderStyle;
  30.     FBorderSize: integer;
  31.     FDropDownRows: integer;
  32.     FMargins: TRect;
  33.     FCursorMode: TCursorMode;
  34.     FShowHeader: boolean;
  35.     FOnButtonClick: TNotifyEvent;
  36.     procedure RedrawBorder;
  37.     procedure SetPopupAlignment(Value: TWindowAlignment);
  38.     procedure SetPopupBorderStyle(Value: TPopupBorderStyle);
  39.     procedure DrawHeader;
  40.     procedure DrawClientRect;
  41.     procedure DrawFooter;
  42.     procedure SetMargins;
  43.     procedure BeginMoving(XCursor, YCursor: integer);
  44.     procedure DoButtonClick(Sender: TObject);
  45.     procedure InvalidateButtons;
  46.     procedure SetShowHeader(const Value: boolean);
  47.     procedure DoDrawHint(Sender: TObject; Mode: Integer);
  48.   protected
  49.     procedure CreateParams(var Params: TCreateParams); override;
  50.     procedure CreateWnd; override;
  51.     procedure WMMouseActivate(var Message: TWMActivate); message WM_MOUSEACTIVATE;
  52.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  53.     procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
  54.     procedure WMFontChange(var Message: TWMFontChange); message WM_FONTCHANGE;
  55.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  56.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  57.     procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
  58.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  59.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  60.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  61.     procedure CMSetAlignment(var Message: TMessage); message CM_SETALIGNMENT;
  62.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  63.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  64.   public
  65.     procedure AdjustNewHeight;
  66.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  67.     procedure SetBoundsEx(ALeft, ATop, AWidth, AHeight: Integer);
  68.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  69.     constructor Create(AOwner: TComponent); override;
  70.     destructor Destroy; override;
  71.     procedure SetParent(AParent: TWinControl); override;
  72.     procedure Show;
  73.     procedure Hide;
  74.     property AlwaysVisible: boolean read FAlwaysVisible write FAlwaysVisible;
  75.     property PopupAlignment: TWindowAlignment read FPopupAlignment
  76.              write SetPopupAlignment;
  77.     property Owner: TControl read FOwner write FOwner;
  78.     property PopupBorderStyle: TPopupBorderStyle read FPopupBorderStyle write SetPopupBorderStyle;
  79.     property DropDownRows: integer read FDropDownRows write FDropDownRows;
  80.     property Columns;
  81.     property OnDblClick;
  82.     property BorderStyle;
  83.     property Buttons: TDCEditButtons read FButtons;
  84.     property ShowHeader: boolean read FShowHeader write SetShowHeader;
  85.     property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
  86.   end;
  87.  
  88.   TDCCustomListComboBox = class(TDCCustomChoiceEdit)
  89.   private
  90.     FListBox: TDCPopupCheckListBox;
  91.     FListBoxVisible: boolean;
  92.     FStyle: TComboBoxStyle;
  93.     FOnDrawItem: TDrawItemEvent;
  94.     FOnDrawText: TDCDrawItemEvent;
  95.     FOnMeasureItem:TMeasureItemEvent;
  96.     FItemHeight: integer;
  97.     FLastText: string;
  98.     FDropDownWidth: integer;
  99.     FHintShow: boolean;
  100.     FInButtonArea: boolean;
  101.     FInCheckArea: boolean;
  102.     FUpdateCount: integer;
  103.     FOnSetText: TSetTextEvent;
  104.     FDropDownCount: integer;
  105.     procedure SetComboBoxStyle(Value: TComboBoxStyle);
  106.     procedure SetItems(Value: TStrings);
  107.     procedure PaintListItem(bFocused: boolean);
  108.     function  NotEditControl: boolean;
  109.     function GetItems: TStrings;
  110.     procedure ListMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
  111.     procedure ListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  112.       State: TOwnerDrawState);
  113.     function GetItemIndex: integer;
  114.     function GetChecked(Index: Integer): Boolean;
  115.     function GetItemEnabled(Index: Integer): Boolean;
  116.     function GetState(Index: Integer): TCheckBoxState;
  117.     procedure SetChecked(Index: Integer; const Value: Boolean);
  118.     procedure SetItemEnabled(Index: Integer; const Value: Boolean);
  119.     procedure SetState(Index: Integer; const Value: TCheckBoxState);
  120.     function GetAllowGrayed: Boolean;
  121.     procedure SetAllowGrayed(const Value: Boolean);
  122.   protected
  123.     procedure CloseUp(State: Byte; bPerform: boolean = False); override;
  124.     procedure Loaded; override; 
  125.     procedure GetHintOnError; override;
  126.     function MinControlWidthBitmap: integer; override;
  127.     function GetDropDownVisible: boolean; override;
  128.     procedure EMGetSel(var Message: TMessage); message EM_GETSEL;
  129.     procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
  130.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  131.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  132.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  133.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  134.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  135.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  136.     procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
  137.     procedure EMSetReadOnly(var Message: TMessage); message EM_SETREADONLY;
  138.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  139.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  140.     procedure CMPopupWindow(var Message: TMessage); message CM_POPUPWINDOW;
  141.     procedure CMPopupButtonClk(var Message: TMessage); message CM_POPUPBUTTONCLK;
  142.     function GetCanvas: TCanvas;
  143.     procedure CheckClick(Sender:TObject); override;
  144.     procedure WndProc(var Message: TMessage); override;
  145.     procedure DefineBtnChoiceStyle; override;
  146.     property Style: TComboBoxStyle read FStyle write SetComboBoxStyle;
  147.     property ItemHeight: integer read FItemHeight write FItemHeight;
  148.     property OnDrawItem: TDrawItemEvent read  FOnDrawItem write FOnDrawItem;
  149.     property OnDrawText: TDCDrawItemEvent read  FOnDrawText write FOnDrawText;
  150.     property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
  151.     property DropDownWidth: integer read FDropDownWidth write FDropDownWidth;
  152.     procedure CreateWnd; override;
  153.     procedure SetText(ASelStart, ASelLen: integer); virtual;
  154.     property Items: TStrings read GetItems write SetItems;
  155.     property ItemIndex: integer read GetItemIndex;
  156.     property AllowGrayed: Boolean read GetAllowGrayed write SetAllowGrayed;
  157.     property OnSetText: TSetTextEvent read FOnSetText write FOnSetText;
  158.     property DropDownCount: Integer read FDropDownCount write FDropDownCount default 8;
  159.   public
  160.     procedure CreateParams(var Params: TCreateParams); override;
  161.     constructor Create(AOwner: TComponent); override;
  162.     destructor Destroy; override;
  163.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  164.     procedure KeyPress(var Key: Char);override;
  165.     procedure KillFocus(var Value: boolean); override;
  166.     procedure Clear; override;
  167.     procedure ChoiceClick(Sender:TObject); override;
  168.     procedure UpdateItems;
  169.     property Canvas: TCanvas read GetCanvas;
  170.     property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
  171.     property ItemEnabled[Index: Integer]: Boolean read GetItemEnabled write SetItemEnabled;
  172.     property State[Index: Integer]: TCheckBoxState read GetState write SetState;
  173.   end;
  174.  
  175.   TDCListComboBox = class(TDCCustomListComboBox)
  176.   public
  177.     property ButtonEnabled;
  178.   published
  179.     property Alignment;
  180.     property DrawStyle;
  181.     property CheckGlyph;
  182.     property CheckTag;
  183.     property ItemHeight;
  184.     property DropDownWidth;
  185.     property OnDrawItem;
  186.     property OnDrawText;
  187.     property OnMeasureItem;
  188.     property Style;
  189.     property ShowCheckBox;
  190.     property Items;
  191.     property ItemIndex;
  192.     property AllowGrayed;
  193.     property OnSetText;
  194.     property DropDownCount;
  195.   end;
  196.  
  197. implementation
  198.  
  199. uses
  200.   DCResource, DCEditTools, DCPopupWindow;
  201.  
  202. type
  203.  
  204.   TPrivateControl = class(TControl)
  205.   end;
  206.  
  207. { TDCPopupCheckListBox }
  208.  
  209. procedure TDCPopupCheckListBox.AdjustNewHeight;
  210. var
  211.   DC: HDC;
  212.   SaveFont: HFONT;
  213.   Metrics: TTextMetric;
  214. begin
  215.   DC := GetDC(0);
  216.   SaveFont := SelectObject(DC, Font.Handle);
  217.   try
  218.     GetTextMetrics (DC, Metrics);
  219.     ItemHeight := Metrics.tmHeight + 3;
  220.   finally
  221.     SelectObject(DC, SaveFont);
  222.     ReleaseDC(0, DC);
  223.   end;
  224. end;
  225.  
  226. procedure TDCPopupCheckListBox.BeginMoving(XCursor, YCursor: integer);
  227. begin
  228.   ProcessMovingWindow(Self, XCursor, YCursor, FCursorMode, ItemHeight);
  229. end;
  230.  
  231. procedure TDCPopupCheckListBox.CMMouseEnter(var Message: TMessage);
  232. begin
  233.   inherited;
  234.   if Assigned(FButtons) then
  235.     FButtons.MouseDown := GetAsyncKeyState(VK_LBUTTON) < 0;
  236. end;
  237.  
  238. procedure TDCPopupCheckListBox.CMMouseLeave(var Message: TMessage);
  239. begin
  240.   inherited;
  241.   if Assigned(FButtons) then
  242.     FButtons.UpdateButtons( -1, -1, False, True);
  243. end;
  244.  
  245. procedure TDCPopupCheckListBox.CMSetAlignment(var Message: TMessage);
  246. begin
  247.   PopupAlignment := TWindowAlignment(Message.WParam);
  248. end;
  249.  
  250. procedure TDCPopupCheckListBox.CNDrawItem(var Message: TWMDrawItem);
  251. var
  252.   State: TOwnerDrawState;
  253. begin
  254.   with Message.DrawItemStruct^ do
  255.   begin
  256.  
  257.     if not UseRightToLeftAlignment then
  258.       rcItem.Left := rcItem.Left + GetCheckWidth
  259.     else
  260.       rcItem.Right := rcItem.Right - GetCheckWidth;
  261.  
  262.     {$IFDEF DELPHI_V5UP}
  263.        State := TOwnerDrawState(LongRec(itemState).Lo);
  264.     {$ELSE}
  265.        State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
  266.     {$ENDIF}
  267.     Canvas.Lock;
  268.     try
  269.       Canvas.Handle := hDC;
  270.       Canvas.Font := Font;
  271.       Canvas.Brush := Brush;
  272.       if (Integer(itemID) >= 0) and (odSelected in State) then
  273.       begin
  274.         Canvas.Brush.Color := clHighlight;
  275.         Canvas.Font.Color := clHighlightText
  276.       end;
  277.       if Integer(itemID) >= 0 then
  278.         DrawItem(itemID, rcItem, State) else
  279.         Canvas.FillRect(rcItem);
  280.     finally
  281.       Canvas.Handle := 0;
  282.       Canvas.Unlock;
  283.     end;
  284.   end;
  285. end;
  286.  
  287. constructor TDCPopupCheckListBox.Create(AOwner: TComponent);
  288. begin
  289.   inherited Create(AOwner);
  290.   FVisible    := False;
  291.   ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable,
  292.                                   csAcceptsControls];
  293.  
  294.   Visible := False;
  295.  
  296.   Canvas.Brush.Style := bsClear;
  297.   FAlwaysVisible := True;
  298.   FOwner := TControl(AOwner);
  299.   Font   := TPrivateControl(AOwner).Font;
  300.  
  301.   SetRectEmpty(FWindowRect);
  302.   SetRectEmpty(FMargins);
  303.   FDropDownRows := 8;
  304.  
  305.   AdjustNewHeight;
  306.  
  307.   {Special ListBox properies}
  308.   FCursorMode := cmNone;
  309.   Style := lbOwnerDrawVariable;
  310.  
  311.   FButtons := TDCEditButtons.Create(Self);
  312.   FButtons.AnchorStyle := asBL;
  313.   FButtons.Color := clBtnFace;
  314.   FButtons.OnlyClientRepaint := True;
  315.  
  316.   FShowHeader := True;
  317. end;
  318.  
  319. procedure TDCPopupCheckListBox.CreateParams(var Params: TCreateParams);
  320. begin
  321.   inherited CreateParams(Params);
  322.   with Params do
  323.   begin
  324.     ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST ;
  325.     AddBiDiModeExStyle(ExStyle);
  326.   end;
  327. end;
  328.  
  329. procedure TDCPopupCheckListBox.CreateWnd;
  330.  var
  331.   LeftPos: integer;
  332.   AButton: TDCEditButton;
  333.   ALeft: integer;
  334. begin
  335.   inherited CreateWnd;
  336.  
  337.   if Parent <> nil then
  338.   begin
  339.     Windows.SetParent(Handle, 0);
  340.     CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
  341.     SetMargins;
  342.  
  343.     FButtons.SetWndProc;
  344.  
  345.     if FShowHeader then
  346.     begin
  347.       LeftPos := 4;
  348.       FButtons.Clear;
  349.  
  350.       AButton := FButtons.AddButton;
  351.       with AButton do
  352.       begin
  353.         Name := '#Close';
  354.         Allignment  := abCenter;
  355.         AnchorStyle := asBL;
  356.         Font     := Self.Font;
  357.         Caption := LoadStr(RES_STRN_VAL_CLOSE);
  358.  
  359.         SetBounds(Rect(LeftPos, Self.Height-br_FooterHeight-5,
  360.           50 + 5, br_FooterHeight+3));
  361.  
  362.         DisableStyle := deNormal;
  363.         Style   := stShadowFlat;
  364.         Enabled := True;
  365.         Visible := False;
  366.         Tag     := 1;
  367.         OnClick := DoButtonClick;
  368.         OnDrawHint := DoDrawHint;
  369.         ALeft   := Left+Width;
  370.       end;
  371.  
  372.       AButton := FButtons.AddButton;
  373.       with AButton do
  374.       begin
  375.         Name := '#Sep_1';
  376.         Allignment  := abImageTop;
  377.         AnchorStyle := asBL;
  378.         Font     := Self.Font;
  379.         Glyph.LoadFromResourceName(HInstance, 'DC_DELIMITER');
  380.  
  381.         SetBounds(Rect(ALeft, Self.Height-br_FooterHeight-5,
  382.           8, br_FooterHeight+3));
  383.  
  384.         DisableStyle := deNormal;
  385.         Style   := stNone;
  386.         Enabled := True;
  387.         Visible := False;
  388.         DrawText:= False;
  389.         Tag     := -1;
  390.         OnDrawHint := DoDrawHint;
  391.         ALeft   := Left+Width;
  392.       end;
  393.  
  394.       AButton := FButtons.AddButton;
  395.       with AButton do
  396.       begin
  397.         Name := '#SelectAll';
  398.         Allignment  := abCenter;
  399.         AnchorStyle := asBL;
  400.         Font     := Self.Font;
  401.         Glyph.LoadFromResourceName(HInstance, 'DC_SELECTALL');
  402.         Comment := LoadStr(RES_STRN_HNT_SELALL);
  403.  
  404.         SetBounds(Rect(ALeft, Self.Height-br_FooterHeight-5,
  405.           FMargins.Bottom-1, br_FooterHeight+3));
  406.  
  407.         DisableStyle := deNormal;
  408.         Style   := stShadowFlat;
  409.         Enabled := True;
  410.         Visible := False;
  411.         Tag     := 2;
  412.         DrawText:= False;
  413.         OnClick := DoButtonClick;
  414.         OnDrawHint := DoDrawHint;
  415.         ALeft   := Left+Width;
  416.       end;
  417.  
  418.       AButton := FButtons.AddButton;
  419.       with AButton do
  420.       begin
  421.         Name := '#deSelectAll';
  422.         Allignment  := abCenter;
  423.         AnchorStyle := asBL;
  424.         Font     := Self.Font;
  425.         Glyph.LoadFromResourceName(HInstance, 'DC_DESELECTALL');
  426.         Comment := LoadStr(RES_STRN_HNT_DESALL);
  427.  
  428.         SetBounds(Rect(ALeft, Self.Height-br_FooterHeight-5,
  429.           FMargins.Bottom-1, br_FooterHeight+3));
  430.  
  431.         DisableStyle := deNormal;
  432.         Style   := stShadowFlat;
  433.         Enabled := True;
  434.         Visible := False;
  435.         Tag     := 3;
  436.         DrawText:= False;
  437.         OnClick := DoButtonClick;
  438.         OnDrawHint := DoDrawHint;
  439.         ALeft   := Left+Width;
  440.       end;
  441.  
  442.       AButton := FButtons.AddButton;
  443.       with AButton do
  444.       begin
  445.         Name := '#Comment';
  446.         Allignment  := abLeft;
  447.         AnchorStyle := asBLR;
  448.         Font     := Self.Font;
  449.  
  450.         SetBounds(Rect(ALeft, Self.Height-br_FooterHeight-5,
  451.           Self.Width-FMargins.Right-ALeft-br_SizerWidth-2*FBorderSize-1, br_FooterHeight+3));
  452.  
  453.         DisableStyle := deLite;
  454.         Style   := stNone;
  455.         Enabled := False;
  456.         Visible := False;
  457.         Tag     := -1;
  458.       end;
  459.       DoDrawHint(nil, 0);
  460.     end;
  461.   end;
  462. end;
  463.  
  464. destructor TDCPopupCheckListBox.Destroy;
  465. begin
  466.   FButtons.Free;
  467.   FButtons := nil;
  468.   inherited;
  469. end;
  470.  
  471. procedure TDCPopupCheckListBox.DoButtonClick(Sender: TObject);
  472.  var
  473.   i: integer;
  474. begin
  475.   if Assigned(FOnButtonClick) then FOnButtonClick(Sender);
  476.   case TDCEditButton(Sender).Tag of
  477.     1{Close}:
  478.       begin
  479.         FOwner.Perform(CM_POPUPBUTTONCLK, Integer(Sender), 0);
  480.       end;
  481.     2{SelectAll}:
  482.       begin
  483.         for i := 0 to Items.Count-1 do
  484.           {$IFDEF DELPHI_V5UP}
  485.              if ItemEnabled[i] then Checked[i] := True;
  486.           {$ELSE}
  487.              Checked[i] := True;
  488.           {$ENDIF}
  489.       end;
  490.     3{deSelectAll}:
  491.       begin
  492.         for i := 0 to Items.Count-1 do
  493.           {$IFDEF DELPHI_V5UP}
  494.              if ItemEnabled[i] then Checked[i] := False;
  495.           {$ELSE}
  496.              Checked[i] := False;
  497.           {$ENDIF}
  498.       end;
  499.   end;
  500. end;
  501.  
  502. procedure TDCPopupCheckListBox.DoDrawHint(Sender: TObject; Mode: Integer);
  503.  var
  504.   Button: TDCEditButton;
  505. begin
  506.   Button := FButtons.FindButton('#Comment');
  507.   if (Button <> nil) then
  508.   begin
  509.     if (Mode = 0) and Assigned(Sender) and (Sender is TDCEditButton) then
  510.       with TDCEditButton(Sender) do Button.Caption := Comment
  511.     else
  512.       Button.Caption := '';
  513.     Button.invalidate;
  514.   end;
  515. end;
  516.  
  517. procedure TDCPopupCheckListBox.DrawClientRect;
  518.  var
  519.   DC: HDC;
  520.   R, R1, R2: TRect;
  521.   Rgn: HRGN;
  522. begin
  523.   if not FShowHeader then Exit;
  524.   DC  := GetWindowDC(Handle);
  525.   Rgn := 0;
  526.   try
  527.     GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  528.  
  529.     R2 := R;
  530.     with FMargins do
  531.     begin
  532.      InflateRect(R2, -2, -2);
  533.      R2.Top := R2.Top + br_HeaderHeight;
  534.      R2.Bottom := R2.Bottom - br_FooterHeight;
  535.     end;
  536.  
  537.     Rgn := CreateRectRgn(R2.Left, R2.Top, R2.Right, R2.Bottom);
  538.     SelectClipRgn(DC, Rgn);
  539.  
  540.     R1 := Rect(FMargins.Left, FMargins.Top, R.Right-FMargins.Right, R.Bottom-FMargins.Bottom);
  541.     R1 := Rect(FMargins.Left, FMargins.Top, R.Right-FMargins.Right, R.Bottom-FMargins.Bottom);
  542.     InflateRect(R1, -1, -1);
  543.  
  544.     DrawEdge(DC, R1, BDR_SUNKENOUTER, BF_TOPLEFT);
  545.     DrawEdge(DC, R1, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
  546.  
  547.     ExcludeClipRect(DC, R1.Left, R1.Top, R1.Right, R1.Bottom);
  548.     FillRect(DC, R,  GetSysColorBrush(clWhite));
  549.   finally
  550.     ReleaseDC(Handle, DC);
  551.     if Rgn <> 0 then DeleteObject(Rgn)
  552.   end;
  553. end;
  554.  
  555. procedure TDCPopupCheckListBox.DrawFooter;
  556.  var
  557.   DC: HDC;
  558.   R: TRect;
  559.   Bitmap: TBitmap;
  560. begin
  561.   if not FShowHeader then Exit;
  562.   DC := GetWindowDC(Handle);
  563.   Bitmap := TBitmap.Create;
  564.   try
  565.     GetWindowRect (Handle, R); OffsetRect (R, -R.Left, -R.Top);
  566.     InflateRect(R, -2, -2);
  567.     Bitmap.LoadFromResourceName(HInstance, 'DC_BTNSIZE');
  568.     R.Top := R.Bottom - br_FooterHeight - 4;
  569.     FillRect(DC, R,  GetSysColorBrush(COLOR_BTNFACE));
  570.     R.Left := R.Right-Bitmap.Width-2;
  571.     R.Top  := R.Bottom-Bitmap.Height-2;
  572.     DrawTransparentBitmap(DC, Bitmap, R, False, Bitmap.Canvas.Pixels[0,0]);
  573.   finally
  574.     Bitmap.Free;
  575.     ReleaseDC(Handle, DC);
  576.   end;
  577. end;
  578.  
  579. procedure TDCPopupCheckListBox.DrawHeader;
  580.  var
  581.   DC: HDC;
  582.   R: TRect;
  583. begin
  584.   if not FShowHeader then Exit;
  585.   DC := GetWindowDC(Handle);
  586.   try
  587.     GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  588.     InflateRect(R, -2, -2);
  589.     R.Bottom := R.Top + br_HeaderHeight;
  590.     FillRect(DC, R,  GetSysColorBrush(COLOR_BTNFACE));
  591.     R.Bottom := R.Bottom - 1;
  592.     DrawCaption(Handle, DC, R, DC_TEXT or DC_SMALLCAP or DC_ACTIVE or DC_GRADIENT);
  593.   finally
  594.     ReleaseDC(Handle, DC);
  595.   end;
  596. end;
  597.  
  598. procedure TDCPopupCheckListBox.Hide;
  599. begin
  600.   HideWindow(Handle);
  601.   FVisible := False;
  602. end;
  603.  
  604. procedure TDCPopupCheckListBox.InvalidateButtons;
  605.  var
  606.   i, RightPos: integer;
  607.   Button: TDCEditButton;
  608.   Changed: boolean;
  609. begin
  610.   RightPos := Width - br_SizerWidth - FBorderSize - FMargins.Left - 3;
  611.   Changed  := False;
  612.   for i := 0 to FButtons.Count-1 do
  613.   begin
  614.     Button := FButtons.Buttons[i];
  615.     if (Button.Left + Button.Width) > RightPos then
  616.     begin
  617.       if Button.Visible then
  618.       begin
  619.         Button.Visible := False;
  620.         Changed := True;
  621.       end
  622.     end
  623.     else
  624.       if not Button.Visible then
  625.       begin
  626.         Button.Visible := True;
  627.         Changed := True;
  628.       end;
  629.   end;
  630.  
  631.   if Changed then SendMessage(Self.Handle, WM_NCPAINT, 0, 0);
  632. end;
  633.  
  634. procedure TDCPopupCheckListBox.KeyDown(var Key: Word; Shift: TShiftState);
  635. begin
  636.   inherited;
  637.   case Key of
  638.     VK_LEFT :
  639.       begin
  640.         if ssCtrl in Shift then
  641.           SetBounds(Left-POPUP_MOVE_STEPX, Top, Width, Height);
  642.       end;
  643.     VK_RIGHT:
  644.       begin
  645.         if ssCtrl in Shift then
  646.           SetBounds(Left+POPUP_MOVE_STEPX, Top, Width, Height);
  647.       end;
  648.     VK_UP   :
  649.       begin
  650.         if ssCtrl in Shift then
  651.           SetBounds(Left, Top-POPUP_MOVE_STEPY, Width, Height);
  652.       end;
  653.     VK_DOWN :
  654.       begin
  655.         if ssCtrl in Shift then
  656.           SetBounds(Left, Top+POPUP_MOVE_STEPY, Width, Height);
  657.       end;
  658.   end;
  659. end;
  660.  
  661. procedure TDCPopupCheckListBox.RedrawBorder;
  662.  var
  663.   DC: HDC;
  664.   R: TRect;
  665.   ABrush: HBRUSH;
  666. begin
  667.   DC := GetWindowDC(Handle);
  668.   try
  669.     GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  670.     case FPopupBorderStyle of
  671.       brNone:;
  672.       brSingle:
  673.         begin 
  674.           ABrush := CreateSolidBrush(clBlack);
  675.           FrameRect( DC, R, ABrush);
  676.           DeleteObject(ABrush);
  677.         end;
  678.       brRaised:
  679.         begin
  680.           DrawEdge(DC, R, BDR_RAISEDOUTER, BF_RECT);
  681.           InflateRect(R, -1, -1);
  682.           DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT);
  683.  
  684.           DrawHeader;
  685.           DrawClientRect;
  686.           DrawFooter;
  687.         end;
  688.     end;
  689.   finally
  690.     ReleaseDC(Handle, DC);
  691.   end;
  692. end;
  693.  
  694. procedure TDCPopupCheckListBox.SetBounds(ALeft, ATop, AWidth,
  695.   AHeight: Integer);
  696. begin
  697.   if AHeight < ItemHeight * 5 then AHeight := ItemHeight * 5;
  698.   if AWidth  < 80 then AWidth  := 80;
  699.   inherited;
  700.   FWindowRect := Rect(Left,Top,Left+Width,Top+Height);
  701. end;
  702.  
  703. procedure TDCPopupCheckListBox.SetBoundsEx(ALeft, ATop, AWidth,
  704.   AHeight: Integer);
  705. begin
  706.   FWindowRect := Rect(ALeft,ATop,ALeft+AWidth,aTop+AHeight);
  707.   if FVisible then Show;
  708. end;
  709.  
  710. procedure TDCPopupCheckListBox.SetMargins;
  711. begin
  712.   FMargins := Rect(4,4,4,2);
  713.   if not FShowHeader then Exit;
  714.   case FPopupBorderStyle of
  715.     brNone  :;
  716.     brSingle:;
  717.     brRaised:
  718.       begin
  719.         // Margins.Properties
  720.         FMargins.Top  := FMargins.Top + br_HeaderHeight;
  721.         FMargins.Bottom := FMargins.Bottom + br_FooterHeight + 4;
  722.       end;
  723.   end;
  724. end;
  725.  
  726. procedure TDCPopupCheckListBox.SetParent(AParent: TWinControl);
  727. begin
  728.   inherited;
  729.   if (AParent <> nil) and (AParent.Parent <> nil) and
  730.      (AParent is TDCCustomChoiceEdit)
  731.   then begin
  732.     Caption := TDCCustomChoiceEdit(AParent).DBObject.Caption;
  733.   end;
  734. end;
  735.  
  736. procedure TDCPopupCheckListBox.SetPopupAlignment(Value: TWindowAlignment);
  737. begin
  738.   if Value <> FPopupAlignment then
  739.   begin
  740.     FPopupAlignment := Value;
  741.     if Visible then Show;
  742.   end;
  743. end;
  744.  
  745. procedure TDCPopupCheckListBox.SetPopupBorderStyle(
  746.   Value: TPopupBorderStyle);
  747. begin
  748.   if FPopupBorderStyle <> Value then
  749.   begin
  750.     FPopupBorderStyle := Value;
  751.     case FPopupBorderStyle of
  752.       brNone  :FBorderSize := 0;
  753.       brSingle:FBorderSize := 1;
  754.       brRaised:FBorderSize := 2;
  755.     end;
  756.     RecreateWnd;
  757.   end;
  758. end;
  759.  
  760. procedure TDCPopupCheckListBox.SetShowHeader(const Value: boolean);
  761. begin
  762.   FShowHeader := Value;
  763.   RecreateWnd;
  764. end;
  765.  
  766. procedure TDCPopupCheckListBox.Show;
  767.  var
  768.   ItemsCount: integer;
  769. begin
  770.   SetMargins;
  771.   if Items.Count < FDropDownRows then
  772.    ItemsCount := Items.Count
  773.   else
  774.    ItemsCount := FDropDownRows;
  775.  
  776.   Height := ItemHeight * ItemsCount + 2*FBorderSize + FMargins.Top + FMargins.Bottom;
  777.   ShowWindow(Handle, FPopupAlignment, FWindowRect, FAlwaysVisible, Owner);
  778.   FVisible  := True;
  779. end;
  780.  
  781. procedure TDCPopupCheckListBox.WMFontChange(var Message: TWMFontChange);
  782.  var
  783.   i: integer;
  784. begin
  785.   inherited;
  786.   AdjustNewHeight;
  787.   for i := 0 to FButtons.Count-1 do
  788.     FButtons.Buttons[i].Font := Font;
  789. end;
  790.  
  791. procedure TDCPopupCheckListBox.WMMouseActivate(var Message: TWMActivate);
  792. begin
  793.   inherited;
  794.   Message.Result := MA_NOACTIVATE;
  795.   SetWindowPos (Handle, HWND_TOP, 0, 0, 0, 0,
  796.      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  797. end;
  798.  
  799. procedure TDCPopupCheckListBox.WMNCCalcSize(var Message: TWMNCCalcSize);
  800. begin
  801.   case FPopupBorderStyle of
  802.     brNone  :FBorderSize := 0;
  803.     brSingle:
  804.       begin
  805.         FBorderSize := 2;
  806.         InflateRect(Message.CalcSize_Params^.rgrc[0], -2, -2);
  807.       end;
  808.     brRaised:
  809.       begin
  810.         FBorderSize := 2;
  811.         InflateRect(Message.CalcSize_Params^.rgrc[0], -2, -2);
  812.       end;
  813.   end;
  814.   with Message.CalcSize_Params^.rgrc[0] do
  815.   begin
  816.     Top    := Top    + FMargins.Top;
  817.     Left   := Left   + FMargins.Left;
  818.     Bottom := Bottom - FMargins.Bottom;
  819.     Right  := Right  - FMargins.Right;
  820.   end;
  821.   inherited;
  822. end;
  823.  
  824. procedure TDCPopupCheckListBox.WMNCHitTest(var Message: TWMNCHitTest);
  825.  var
  826.   R, WindowR: TRect;
  827.   BS: Integer;
  828.   Button: TDCEditButton;
  829.  function InCaptArea(XPos, YPos: integer): boolean;
  830.  begin
  831.    R := WindowR;
  832.    InflateRect(R, -BS, -BS);
  833.    R.Bottom := R.Top + FMargins.Top;
  834.    Result := PtInRect(R, Point(XPos, YPos));
  835.  end;
  836.  function InSizeArea(XPos, YPos: integer): boolean;
  837.  begin
  838.    R := WindowR;
  839.    InflateRect(R, -BS, -BS);
  840.    R.Top  := R.Bottom - br_FooterHeight;
  841.    R.Left := R.Right  - br_SizerWidth;
  842.    Result := PtInRect(R, Point(XPos, YPos));
  843.  end;
  844.  function InGridArea(XPos, YPos: integer): boolean;
  845.  begin
  846.    R := WindowR;
  847.    InflateRect(R, -BS, -BS);
  848.    R.Left   := R.Left   + FMargins.Left;
  849.    R.Top    := R.Top    + FMargins.Top;
  850.    R.Right  := R.Right  - FMargins.Right;
  851.    R.Bottom := R.Bottom - FMargins.Bottom;
  852.    Result := PtInRect(R, Point(XPos, YPos));
  853.  end;
  854.  function InButtonsArea(XPos, YPos: integer): boolean;
  855.   var
  856.    P: TPoint;
  857.  begin
  858.    P.X := XPos - Left;
  859.    P.Y := YPos - Top;
  860.    Result := FButtons.MouseInButtonArea(P.X, P.Y, Button);
  861.    R := WindowR;
  862.    InflateRect(R, -BS, -BS);
  863.  end;
  864.  function InFooterArea(XPos, YPos: integer): boolean;
  865.  begin
  866.    R := WindowR;
  867.    InflateRect(R, -BS, -BS);
  868.    R.Top  := R.Bottom - br_FooterHeight;
  869.    Result := PtInRect(R, Point(XPos, YPos));
  870.  end;
  871. begin
  872.   inherited;
  873.  
  874.   if not FShowHeader then begin
  875.     FCursorMode := cmGrid;
  876.     Exit;
  877.   end;
  878.  
  879.   FCursorMode := cmNone;
  880.   BS := FBorderSize;
  881.   GetWindowRect(Handle, WindowR);
  882.   with Message do
  883.   begin
  884.     if InCaptArea(XPos, YPos) then
  885.     begin
  886.       FCursorMode := cmMove;
  887.       Result := HTBORDER;
  888.     end;
  889.  
  890.     if InFooterArea(XPos, YPos) then
  891.     begin
  892.       FCursorMode := cmFooter;
  893.       Result := HTBORDER;
  894.     end;
  895.  
  896.     if InSizeArea(XPos, YPos) then
  897.     begin
  898.       FCursorMode := cmResize;
  899.       Result := HTSIZE;
  900.     end;
  901.  
  902.     if InGridArea(XPos, YPos) then FCursorMode := cmGrid;
  903.  
  904.     if InButtonsArea(XPos, YPos) then
  905.     begin
  906.       FCursorMode := cmButtons;
  907.       Result := HTBORDER;
  908.     end;
  909.   end;
  910. end;
  911.  
  912. procedure TDCPopupCheckListBox.WMNCLButtonDown(
  913.   var Message: TWMNCLButtonDown);
  914. begin
  915.   inherited;
  916.   with Message do
  917.   begin
  918.     case FCursorMode of
  919.       cmResize, cmMove: BeginMoving(XCursor, YCursor);
  920.     end;
  921.   end;
  922. end;
  923.  
  924. procedure TDCPopupCheckListBox.WMNCPaint(var Message: TWMNCPaint);
  925. begin
  926.   inherited;
  927.   RedrawBorder;
  928. end;
  929.  
  930. procedure TDCPopupCheckListBox.WMPaint(var Message: TWMPaint);
  931. begin
  932.   if Assigned(FButtons) then  FButtons.UpdateDeviceRegion(Message.DC);
  933.   inherited;
  934.   if Assigned(FButtons) then InvalidateButtons;
  935. end;
  936.  
  937. procedure TDCPopupCheckListBox.WMSetCursor(var Message: TWMSetCursor);
  938. begin
  939.   case FCursorMode of
  940.     cmNone   : SetCursor(Screen.Cursors[crArrow]);
  941.     cmResize : SetCursor(Screen.Cursors[crSizeNWSE]);
  942.     cmMove   : SetCursor(Screen.Cursors[crArrow]);
  943.     cmButtons: SetCursor(Screen.Cursors[crArrow]);
  944.     cmFooter : SetCursor(Screen.Cursors[crArrow]);
  945.     cmGrid   : inherited;
  946.   end;
  947. end;
  948.  
  949. procedure TDCPopupCheckListBox.WMSize(var Message: TWMSize);
  950. begin
  951.   inherited;
  952.   if Assigned(FButtons) then InvalidateButtons;
  953. end;
  954.  
  955. { TDCCustomListComboBox }
  956.  
  957. procedure TDCCustomListComboBox.CheckClick(Sender: TObject);
  958. begin
  959.   inherited;
  960.   if NotEditControl then HideCaret(Handle);
  961. end;
  962.  
  963. procedure TDCCustomListComboBox.ChoiceClick(Sender: TObject);
  964. begin
  965.   if FListBoxVisible then
  966.     CloseUp(0, True)
  967.   else
  968.     Perform(CM_POPUPWINDOW, 1, 0);
  969. end;
  970.  
  971. procedure TDCCustomListComboBox.Clear;
  972. begin
  973.   Items.Clear;
  974. end;
  975.  
  976. procedure TDCCustomListComboBox.CloseUp(State: Byte; bPerform: boolean);
  977. begin
  978.  if FListBoxVisible then SetText(0, -1);
  979.   case State of
  980.      0: SelLength := 0;
  981.      1: FLastText := Text;
  982.   end;
  983.   inherited;
  984. end;
  985.  
  986. procedure TDCCustomListComboBox.CMCancelMode(var Message: TCMCancelMode);
  987. begin
  988.   if (Message.Sender <> Self) and
  989.      (Message.Sender <> FListBox) and
  990.      not FListBox.ContainsControl(Message.Sender) then
  991.   begin
  992.     inherited;
  993.   end;
  994. end;
  995.  
  996. procedure TDCCustomListComboBox.CMEnter(var Message: TCMEnter);
  997. begin
  998.   inherited;
  999.   PaintListItem(Focused);
  1000. end;
  1001.  
  1002. procedure TDCCustomListComboBox.CMPopupButtonClk(var Message: TMessage);
  1003. begin
  1004.   case TDCEditButton(Message.WParam).Tag of
  1005.     1{Close}: CloseUp(1, False);
  1006.   end;
  1007. end;
  1008.  
  1009. procedure TDCCustomListComboBox.CMPopupWindow(var Message: TMessage);
  1010. begin
  1011.   case Message.WParam of
  1012.     0:
  1013.      if FListBoxVisible then
  1014.      begin
  1015.        FListBoxVisible := False;
  1016.        FListBox.Hide;
  1017.        if BtnChoiceAssigned then ButtonChoice.ResetProperties;
  1018.        ShowHint  := FHintShow;
  1019.        PaintListItem(Focused);
  1020.      end;
  1021.     1:
  1022.      begin
  1023.        PaintListItem(False);
  1024.        FHintShow := ShowHint;
  1025.        ShowHint  := False;
  1026.        with FListBox do
  1027.        begin
  1028.          Color := Self.Color;
  1029.          Parent := Self;
  1030.          PopupAlignment := wpBottomLeft;
  1031.          DropDownRows := DropDownCount;
  1032.          case DrawStyle of
  1033.            FcsNormal,
  1034.            fsNone   : FListBox.PopupBorderStyle := brRaised;
  1035.            fsSingle : FListBox.PopupBorderStyle := brRaised;
  1036.            fsFlat   : FListBox.PopupBorderStyle := brRaised;
  1037.          end;
  1038.          if FDropDownWidth = 0 then Width := Self.Width
  1039.            else Width :=FDropDownWidth;
  1040.          ItemHeight := FItemHeight;
  1041.          SelectAll;
  1042.          Show;
  1043.          FListBoxVisible := True;
  1044.        end
  1045.      end;
  1046.   end;
  1047. end;
  1048.  
  1049. constructor TDCCustomListComboBox.Create(AOwner: TComponent);
  1050. begin
  1051.   inherited Create(AOwner);
  1052.   FListBoxVisible := False;
  1053.   FListBox := TDCPopupCheckListBox.Create(Self);
  1054.   with FListBox do
  1055.   begin
  1056.     Parent := Self;
  1057.     OnMeasureItem := ListMeasureItem;
  1058.     OnDrawItem    := ListDrawItem;
  1059.   end;
  1060.   ReadOnly := True;
  1061.   FUpdateCount := 0;
  1062.   FDropDownCount := 8;
  1063. end;
  1064.  
  1065. procedure TDCCustomListComboBox.CreateParams(var Params: TCreateParams);
  1066. begin
  1067.   inherited;
  1068.   if NotEditControl then
  1069.   begin
  1070.     with Params do
  1071.     begin
  1072.       Text  := Name;
  1073.       Style := WS_CHILD or WS_CLIPSIBLINGS;
  1074.       AddBiDiModeExStyle(ExStyle);
  1075.       if csAcceptsControls in ControlStyle then
  1076.       begin
  1077.         Style := Style or WS_CLIPCHILDREN;
  1078.         ExStyle := ExStyle or WS_EX_CONTROLPARENT;
  1079.       end;
  1080.       if DrawStyle = fsNone then
  1081.         ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
  1082.       if DrawStyle = fsSingle then
  1083.         Style := Style or WS_BORDER;
  1084.       if not (csDesigning in ComponentState) and not Enabled then
  1085.         Style := Style or WS_DISABLED;
  1086.       if TabStop then Style := Style or WS_TABSTOP;
  1087.       if Parent <> nil then
  1088.         WndParent := Parent.Handle else
  1089.         WndParent := ParentWindow;
  1090.       WindowClass.style := CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS;
  1091.       WindowClass.lpfnWndProc := @DefWindowProc;
  1092.       WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
  1093.       WindowClass.hbrBackground := 0;
  1094.       WindowClass.hInstance := HInstance;
  1095.       StrPCopy(WinClassName, ClassName);
  1096.     end;
  1097.   end
  1098. end;
  1099.  
  1100. procedure TDCCustomListComboBox.CreateWnd;
  1101. begin
  1102.   inherited;
  1103.   SetText(-1, 0);
  1104. end;
  1105.  
  1106. procedure TDCCustomListComboBox.DefineBtnChoiceStyle;
  1107. begin
  1108.   if BtnChoiceAssigned then
  1109.   begin
  1110.     ButtonChoiceStyle := btsCombo;
  1111.     ButtonStyle := esDropDown;
  1112.   end;
  1113. end;
  1114.  
  1115. destructor TDCCustomListComboBox.Destroy;
  1116. begin
  1117.   FListBox.Free;
  1118.   inherited;
  1119. end;
  1120.  
  1121. procedure TDCCustomListComboBox.EMGetSel(var Message: TMessage);
  1122. begin
  1123.   if FStyle = csDropDownList then
  1124.   with Message do
  1125.   begin
  1126.     lParam := 0;
  1127.     wParam := GetTextLen;
  1128.   end
  1129.   else
  1130.     inherited
  1131. end;
  1132.  
  1133. procedure TDCCustomListComboBox.EMSetReadOnly(var Message: TMessage);
  1134. begin
  1135.   Message.WParam := Integer(False);
  1136. end;
  1137.  
  1138. function TDCCustomListComboBox.GetAllowGrayed: Boolean;
  1139. begin
  1140.   Result := FListBox.AllowGrayed
  1141. end;
  1142.  
  1143. function TDCCustomListComboBox.GetCanvas: TCanvas;
  1144. begin
  1145.   if FListBoxVisible then
  1146.      Result := FListBox.Canvas
  1147.   else
  1148.      Result := nil;
  1149. end;
  1150.  
  1151. function TDCCustomListComboBox.GetChecked(Index: Integer): Boolean;
  1152. begin
  1153.   Result := FListBox.Checked[Index];
  1154. end;
  1155.  
  1156. function TDCCustomListComboBox.GetDropDownVisible: boolean;
  1157. begin
  1158.   Result := FListBoxVisible;
  1159. end;
  1160.  
  1161. procedure TDCCustomListComboBox.GetHintOnError;
  1162. begin
  1163.   inherited;
  1164. end;
  1165.  
  1166. function TDCCustomListComboBox.GetItemEnabled(Index: Integer): Boolean;
  1167. begin
  1168.   {$IFDEF DELPHI_V5UP}
  1169.   Result := FListBox.ItemEnabled[Index];
  1170.   {$ELSE}
  1171.   Result := True;
  1172.   {$ENDIF}
  1173. end;
  1174.  
  1175. function TDCCustomListComboBox.GetItemIndex: integer;
  1176. begin
  1177.   Result := FListBox.ItemIndex;
  1178. end;
  1179.  
  1180. function TDCCustomListComboBox.GetItems: TStrings;
  1181. begin
  1182.   Result := FListBox.Items;
  1183. end;
  1184.  
  1185. function TDCCustomListComboBox.GetState(Index: Integer): TCheckBoxState;
  1186. begin
  1187.   Result := FListBox.State[Index];
  1188. end;
  1189.  
  1190. procedure TDCCustomListComboBox.KeyDown(var Key: Word; Shift: TShiftState);
  1191.  var
  1192.   KeyDownEvent: TKeyEvent;
  1193. begin
  1194.   KeyDownEvent := OnKeyDown;
  1195.   if FListBoxVisible and (FListBox<>nil) then
  1196.     case Key of
  1197.       VK_PRIOR,
  1198.       VK_NEXT ,
  1199.       VK_UP   ,
  1200.       VK_DOWN   :
  1201.         begin
  1202.           if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  1203.           if (FListBox.ItemIndex = -1) and not(ssCtrl in Shift) then
  1204.             FListBox.ItemIndex := 0
  1205.           else
  1206.             SendMessage(FListBox.Handle, WM_KEYDOWN, Key, 0);
  1207.           Key := 0;
  1208.         end;
  1209.     end
  1210.   else begin
  1211.     if [ssAlt]*Shift = [ssAlt] then
  1212.     begin
  1213.       case Key of
  1214.         VK_DOWN:
  1215.           if FStyle <> csSimple then
  1216.           begin
  1217.             if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  1218.             if Key <> 0 then ChoiceButtonDown;
  1219.             Key := 0;
  1220.           end;
  1221.       end
  1222.     end;
  1223.   end;
  1224.   if Key <> 0 then inherited;
  1225. end;
  1226.  
  1227. procedure TDCCustomListComboBox.KeyPress(var Key: Char);
  1228. begin
  1229.   if FListBoxVisible  and (FListBox<>nil) then
  1230.   begin
  1231.     case Key of
  1232.       Char(VK_RETURN): begin CloseUp(1, True); Key := #0; end;
  1233.       Char(VK_ESCAPE): begin CloseUp(0, True); Key := #0; end;
  1234.       else begin
  1235.         FListBox.KeyPress(Key);
  1236.         Key := #0;
  1237.       end;
  1238.     end;
  1239.   end
  1240.   else begin
  1241.     case Key of
  1242.       Char(VK_ESCAPE): SetText(-1, 0);
  1243.     end;
  1244.   end;
  1245.   inherited KeyPress(Key);
  1246. end;
  1247.  
  1248. procedure TDCCustomListComboBox.KillFocus(var Value: boolean);
  1249. begin
  1250.  inherited KillFocus(Value);
  1251. end;
  1252.  
  1253. procedure TDCCustomListComboBox.ListDrawItem(Control: TWinControl;
  1254.   Index: Integer; Rect: TRect; State: TOwnerDrawState);
  1255. begin
  1256.   if Index < Items.Count then
  1257.   begin
  1258.     if Assigned(FOnDrawItem) then
  1259.       FOnDrawItem(Control, Index, Rect, State)
  1260.     else begin
  1261.       Canvas.FillRect(Rect);
  1262.       Canvas.TextOut(Rect.Left + 2, Rect.Top, Items[Index]);
  1263.     end;
  1264.   end;
  1265. end;
  1266.  
  1267. procedure TDCCustomListComboBox.ListMeasureItem(Control: TWinControl;
  1268.   Index: Integer; var Height: Integer);
  1269. begin
  1270.   if Assigned(FOnMeasureItem) then FOnMeasureItem(Control, Index, Height);
  1271. end;
  1272.  
  1273. procedure TDCCustomListComboBox.Loaded;
  1274. begin
  1275.   inherited;
  1276.   UpdateItems;
  1277. end;
  1278.  
  1279. function TDCCustomListComboBox.MinControlWidthBitmap: integer;
  1280. begin
  1281.   if Style <> csDropDownList then
  1282.     Result := inherited MinControlWidthBitmap
  1283.   else
  1284.     Result := 2;
  1285. end;
  1286.  
  1287. function TDCCustomListComboBox.NotEditControl: boolean;
  1288. begin
  1289.   Result := FStyle = csDropDownList;
  1290. end;
  1291.  
  1292. procedure TDCCustomListComboBox.PaintListItem(bFocused: boolean);
  1293. const
  1294.   Alignments: array[Boolean, TAlignment] of DWORD =
  1295.     ((DT_LEFT, DT_RIGHT, DT_CENTER),(DT_RIGHT, DT_LEFT, DT_CENTER));
  1296.  var
  1297.   DC: HDC;
  1298.   R: TRect;
  1299.   ACanvas: TCanvas;
  1300. begin
  1301.   if not NotEditControl then Exit;
  1302.  
  1303.   ACanvas := TControlCanvas.Create;
  1304.  
  1305.   DC := GetWindowDC(Handle);
  1306.  
  1307.   GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  1308.   if PaintCheckGlyph  then R.Left := R.Left + CheckGlyph.Width + 2;
  1309.   if ButtonWidth > 0 then
  1310.   begin
  1311.     R.Right := R.Right - ButtonWidth;
  1312.     if DrawStyle = fsFlat then R.Right := R.Right - 1
  1313.   end;
  1314.   case DrawStyle of
  1315.     fsNone  :
  1316.      begin
  1317.        InflateRect(R, -1, -1);
  1318.        R.Left := R.Left -1;
  1319.      end;
  1320.     fsSingle  :
  1321.      InflateRect(R, -2, -2);
  1322.     FcsNormal,
  1323.     fsFlat  :
  1324.      InflateRect(R, -3, -3);
  1325.   end;
  1326.  
  1327.   ACanvas.Handle := DC;
  1328.   ACanvas.Font         := Font;
  1329.   ACanvas.Brush.Color  := Color;
  1330.   InflateRect(R, 1, 1);
  1331.   FillRect(ACanvas.Handle, R, ACanvas.Brush.Handle);
  1332.   InflateRect(R, -1, -1);
  1333.  
  1334.   if bFocused then
  1335.   begin
  1336.     ACanvas.Brush.Color := clHighlight;
  1337.     ACanvas.Font.Color  := clHighlightText;
  1338.   end;
  1339.  
  1340.   try
  1341.     if DrawStyle = fsNone then R.Left  := R.Left  +1;
  1342.     FillRect(ACanvas.Handle, R, ACanvas.Brush.Handle);
  1343.     if bFocused then DrawFocusRect(ACanvas.Handle, R);
  1344.     InflateRect(R, -1, -1);
  1345.     SetBkMode(ACanvas.Handle, TRANSPARENT);
  1346.     case DrawStyle of
  1347.       FcsNormal,
  1348.       fsFlat  ,
  1349.       fsNone  : R.Top  := R.Top  -1;
  1350.     end;
  1351.  
  1352.     if Assigned(FOnDrawText) then
  1353.       FOnDrawText(ACanvas, Self, ItemIndex, R, [])
  1354.     else
  1355.       DrawText(ACanvas.Handle, PChar(Text), Length(Text), R,
  1356.         Alignments[UseRightToLeftAlignment, Alignment]);
  1357.   finally
  1358.     ReleaseDC(Handle, DC);
  1359.     ACanvas.Handle := 0;
  1360.     ACanvas.Free;
  1361.   end;
  1362. end;
  1363.  
  1364. procedure TDCCustomListComboBox.SetAllowGrayed(const Value: Boolean);
  1365. begin
  1366.   FListBox.AllowGrayed := Value;
  1367. end;
  1368.  
  1369. procedure TDCCustomListComboBox.SetChecked(Index: Integer;
  1370.   const Value: Boolean);
  1371. begin
  1372.   FListBox.Checked[Index] := Value;
  1373.   UpdateItems;
  1374.   if Style = csDropDownList then PaintListItem(Focused);
  1375. end;
  1376.  
  1377. procedure TDCCustomListComboBox.SetComboBoxStyle(Value: TComboBoxStyle);
  1378. begin
  1379.   if FStyle <> Value then
  1380.   begin
  1381.     FStyle := Value;
  1382.     case FStyle of
  1383.        csDropDown:
  1384.          ButtonExist := True;
  1385.        csSimple:
  1386.          ButtonExist := False;
  1387.        csDropDownList:
  1388.          begin
  1389.            ButtonExist := True;
  1390.            Text := ''
  1391.          end;
  1392.        csOwnerDrawFixed:
  1393.          ButtonExist := True;
  1394.        csOwnerDrawVariable:
  1395.          ButtonExist := True;
  1396.     end;
  1397.     RecreateWnd;
  1398.     SetText(-1, 0);
  1399.   end;
  1400. end;
  1401.  
  1402. procedure TDCCustomListComboBox.SetItemEnabled(Index: Integer;
  1403.   const Value: Boolean);
  1404. begin
  1405.   {$IFDEF DELPHI_V5UP}
  1406.   FListBox.ItemEnabled[Index] := Value;;
  1407.   {$ENDIF}
  1408. end;
  1409.  
  1410. procedure TDCCustomListComboBox.SetItems(Value: TStrings);
  1411. begin
  1412.   FListBox.Items.Assign(Value);
  1413. end;
  1414.  
  1415. procedure TDCCustomListComboBox.SetState(Index: Integer;
  1416.   const Value: TCheckBoxState);
  1417. begin
  1418.   FListBox.State[Index] := Value;
  1419. end;
  1420.  
  1421. procedure TDCCustomListComboBox.SetText(ASelStart, ASelLen: integer);
  1422.  var
  1423.   i: integer;
  1424.   AText, BText: string;
  1425. begin
  1426.   BText := Text;
  1427.   AText := '';
  1428.  
  1429.   for i := 0 to Items.Count-1 do
  1430.   begin
  1431.     if FListBox.Checked[i] then
  1432.       if AText <> '' then
  1433.         AText := AText + ', ' + Items[i]
  1434.       else
  1435.         AText := Items[i];
  1436.   end;
  1437.   if Assigned(FOnSetText) then FOnSetText(Self, AText);
  1438.  
  1439.   Text := Format('[%s]', [AText]);
  1440.  
  1441.   if not NotEditControl then SendMessage(Handle, EM_SETSEL, ASelLen, ASelStart);
  1442.   if BText <> Text then Change;
  1443. end;
  1444.  
  1445. procedure TDCCustomListComboBox.UpdateItems;
  1446. begin
  1447.   SetText(-1, 0);
  1448. end;
  1449.  
  1450. procedure TDCCustomListComboBox.WMEraseBkGnd(var Message: TWMEraseBkGnd);
  1451. begin
  1452.   if FStyle = csDropDownList then
  1453.     Message.Result := 0
  1454.   else
  1455.    inherited;
  1456. end;
  1457.  
  1458. procedure TDCCustomListComboBox.WMGetDlgCode(var Message: TWMGetDlgCode);
  1459. begin
  1460.   Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS or DLGC_WANTALLKEYS;
  1461. end;
  1462.  
  1463. procedure TDCCustomListComboBox.WMKillFocus(var Message: TWMKillFocus);
  1464. begin
  1465.   inherited;
  1466.   if Assigned(Items) then PaintListItem(False);
  1467. end;
  1468.  
  1469. procedure TDCCustomListComboBox.WMLButtonDblClk(
  1470.   var Message: TWMLButtonDown);
  1471. begin
  1472.   if not DisableButtons and (FStyle = csDropDownList) then
  1473.   begin
  1474.     Message.Result := $AE;
  1475.     inherited WMLButtonDblClk(Message);
  1476.   end
  1477.   else inherited;
  1478. end;
  1479.  
  1480. procedure TDCCustomListComboBox.WMNCHitTest(var Message: TWMNCHitTest);
  1481.  var
  1482.   P: TPoint;
  1483. begin
  1484.   inherited;
  1485.   P := Self.ScreenToClient(Point(Message.XPos, Message.YPos));
  1486.  
  1487.   if ShowCheckBox and Assigned(CheckGlyph) and (P.X < CheckGlyph.Width) and
  1488.      ((Width-CheckGlyph.Width) >= MinControlWidthBitmap) then
  1489.     FInCheckArea := True
  1490.   else
  1491.     FInCheckArea := False;
  1492.  
  1493.   if BtnChoiceAssigned and (P.X >= (Width - ButtonWidth - 2)) then
  1494.     FInButtonArea := True
  1495.   else
  1496.     FInButtonArea := False;
  1497.  
  1498.   inherited;
  1499. end;
  1500.  
  1501. procedure TDCCustomListComboBox.WMPaint(var Message: TWMPaint);
  1502.  var
  1503.   PS: TPaintStruct;
  1504. begin
  1505.   if not NotEditControl then
  1506.     inherited
  1507.   else begin
  1508.    BeginPaint(Handle, PS);
  1509.    RedrawBorder(True, 0);
  1510.    PaintListItem(Focused and not FListBoxVisible);
  1511.    EndPaint(Handle, PS);
  1512.  end;
  1513. end;
  1514.  
  1515. procedure TDCCustomListComboBox.WMSetCursor(var Message: TWMSetCursor);
  1516. begin
  1517.   if NotEditControl then SetCursor(LoadCursor(0, IDC_ARROW)) else inherited;
  1518. end;
  1519.  
  1520. procedure TDCCustomListComboBox.WMSetFocus(var Message: TWMSetFocus);
  1521. begin
  1522.   FLastText := Text;
  1523.   inherited;
  1524.   if NotEditControl then HideCaret(Handle);
  1525. end;
  1526.  
  1527. procedure TDCCustomListComboBox.WndProc(var Message: TMessage);
  1528.  var
  1529.    lFocused: boolean;
  1530. begin
  1531.   lFocused := Focused;
  1532.   inherited WndProc(Message);
  1533.   if csDesigning in ComponentState then Exit;
  1534.   case Message.Msg of
  1535.     WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  1536.       begin
  1537.         if NotEditControl and not(FInButtonArea or FInCheckArea) then
  1538.         begin
  1539.           if not Focused then SetFocus;
  1540.           if Focused then with ButtonChoice do
  1541.             UpdateButtonState(Left+1, Top+1, True, False);
  1542.         end;
  1543.         if not NotEditControl and not lFocused then SelectAll;
  1544.       end;
  1545.   end;
  1546. end;
  1547.  
  1548. end.
  1549.