scombobox.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit sComboBox;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  {$IFDEF TNTUNICODE}TntControls, TntClasses, TntActnList, TntStdCtrls, TntGraphics, {$ENDIF}
  StdCtrls, sConst, sDefaults, acSBUtils,
  sCommonData{$IFDEF LOGGED}, sDebugMsgs{$ENDIF};

type
{$IFNDEF NOTFORHELP}
  TsCustomComboBox = class(TCustomComboBox{$IFDEF TNTUNICODE}, IWideCustomListControl{$ENDIF})
  private
    FAlignment : TAlignment;
    FButtonMargin: integer;
    FReadOnly: boolean;
    FDisabledKind: TsDisabledKind;
    FCommonData: TsCommonData;
    FBoundLabel: TsBoundLabel;
    FShowButton: boolean;
{$IFDEF TNTUNICODE}
    FItems: TTntStrings;
    FSaveItems: TTntStrings;
    FSaveItemIndex: Integer;
    FFilter: WideString;
    FLastTime: Cardinal;
    function GetItems: TTntStrings;
    function GetSelStart: Integer;
    procedure SetSelStart(const Value: Integer);
    function GetSelLength: Integer;
    procedure SetSelLength(const Value: Integer);
    function GetSelText: WideString;
    procedure SetSelText(const Value: WideString);
    function GetText: WideString;
    procedure SetText(const Value: WideString);
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    function GetHint: WideString;
    procedure SetHint(const Value: WideString);
    function IsHintStored: Boolean;
    procedure WMChar(var Message: TWMChar); message WM_CHAR;
{$ENDIF}
    function ButtonRect: TRect;
    procedure SetAlignment(const Value: TAlignment);
    procedure SetButtonMargin(const Value: integer);
    procedure SetReadOnly(const Value: boolean);
    procedure SetDisabledKind(const Value: TsDisabledKind);
    procedure SetShowButton(const Value: boolean);
  protected
    lboxhandle : hwnd;
    ListSW : TacScrollWnd;
    OldDropcountValue : integer;
{$IFDEF TNTUNICODE}
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure DefineProperties(Filer: TFiler); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure DestroyWnd; override;
    function GetAutoComplete_UniqueMatchOnly: Boolean; dynamic;
    function GetAutoComplete_PreserveDataEntryCase: Boolean; dynamic;
    procedure DoEditCharMsg(var Message: TWMChar); virtual;
    procedure CreateWnd; override;
    procedure KeyPress(var Key: AnsiChar); override;
    {$IFDEF DELPHI7} // fix for Delphi 7 only
    function GetItemsClass: TCustomComboBoxStringsClass; override;
    {$ENDIF}
    procedure SetItems(const Value: TTntStrings); reintroduce; virtual;
{$ENDIF}
    function FullPaint : boolean; virtual;
    procedure PrepareCache;
    procedure PaintText; virtual;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure OurPaintHandler(iDC : hdc);
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure DrawSkinItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);

    procedure WndProc (var Message: TMessage); override;
    procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); override;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonDblClk(var Message: TMessage); message WM_LBUTTONDBLCLK;
  public
    FChildHandle: HWND;
    FDefListProc: Pointer;
    FDropDown : boolean;

    bFormHandle : hwnd;
    bFormDefProc: Pointer;

    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;

    function IndexOf(const s : string) : integer;
    procedure Invalidate; override;

    procedure PaintButton;
    function ButtonHeight : integer;

    procedure AfterConstruction; override;
    procedure Loaded; override;
    function Focused: Boolean; override;
    property ButtonMargin : integer read FButtonMargin write SetButtonMargin default 1;
{$IFDEF TNTUNICODE}
    procedure CopySelection(Destination: TCustomListControl); override;
    procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
{$ENDIF}
    property ShowButton : boolean read FShowButton write SetShowButton default True;
  published
{$IFDEF TNTUNICODE}
    property SelText: WideString read GetSelText write SetSelText;
    property SelStart: Integer read GetSelStart write SetSelStart;
    property SelLength: Integer read GetSelLength write SetSelLength;
    property Text: WideString read GetText write SetText;
    property Items: TTntStrings read GetItems write SetItems;
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
{$ENDIF}
    property Align;
    property Alignment : TAlignment read FAlignment write SetAlignment;       //KJS
    property BoundLabel : TsBoundLabel read FBoundLabel write FBoundLabel;
    property DisabledKind : TsDisabledKind read FDisabledKind write SetDisabledKind default DefDisabledKind;
    property DropDownCount default 16;
    property SkinData : TsCommonData read FCommonData write FCommonData;
    property ReadOnly : boolean read FReadOnly write SetReadOnly default False;
  end;
{$ENDIF} // NOTFORHELP

  TsComboBox = class(TsCustomComboBox)
{$IFNDEF NOTFORHELP}
    property Style; {Must be published before Items}
    property Anchors;
{$IFDEF DELPHI7UP}
    property AutoComplete;
{$ENDIF}
    property BiDiMode;
    property CharCase;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    property ItemIndex;
    property MaxLength;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
{$IFDEF DELPHI6UP}
    property OnCloseUp;
    property OnSelect;
{$ENDIF}
    property OnChange;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnStartDock;
    property OnStartDrag;
    property Items; { Must be published after OnMeasureItem }
{$ENDIF} // NOTFORHELP
    property BoundLabel;
    property DisabledKind;
    property SkinData;
    property ReadOnly;
  end;


implementation

uses sStyleSimply, sSkinProps, sVCLUtils, sMessages, sAlphaGraph,
  acntUtils, sGraphUtils, sSkinManager;

var
  bFlag : boolean = False;

function IsOwnerDraw(Ctrl : TsCustomComboBox) : boolean;
begin
  Result := (Ctrl.Style in [csOwnerDrawFixed, csOwnerDrawVariable]) and Assigned(Ctrl.OnDrawItem)
end;

{ TsCustomComboBox }

{$IFDEF TNTUNICODE}
procedure TsCustomComboBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
  inherited;
end;

procedure TsCustomComboBox.AddItem(const Item: WideString; AObject: TObject);
begin
  TntComboBox_AddItem(Items, Item, AObject);
end;
{$ENDIF}

procedure TsCustomComboBox.AfterConstruction;
begin
  inherited AfterConstruction;
  FCommonData.Loaded;
end;

function TsCustomComboBox.ButtonHeight: integer;
begin
  if FCommonData.Skinned and (FCommonData.SkinManager.ConstData.ComboGlyph > -1)
    then Result := HeightOf(FCommonData.SkinManager.ma[FCommonData.SkinManager.ConstData.ComboGlyph].R) div (1 + FCommonData.SkinManager.ma[FCommonData.SkinManager.ConstData.ComboGlyph].MaskType)
    else Result := 16;
end;

function TsCustomComboBox.ButtonRect: TRect;
var
  w : integer;
begin
  if (Style <> csSimple) and FShowButton then w := GetSystemMetrics(SM_CXVSCROLL) else w := 0;
  if UseRightToLeftAlignment then Result.Left := 3 else Result.Left := Width - w - 3;
  Result.Top := 3;
  Result.Right := Result.Left + w;
  Result.Bottom := Height - 3;
end;

{$IFDEF TNTUNICODE}
procedure TsCustomComboBox.CNCommand(var Message: TWMCommand);
begin
  if not TntCombo_CNCommand(Self, Items, Message) then inherited;
end;
{$ENDIF}

procedure TsCustomComboBox.CNDrawItem(var Message: TWMDrawItem);
var
  b1, b2 : boolean;
  ds : TDrawItemStruct;
begin
  ds :=  Message.DrawItemStruct^;
  b1 := (ds.itemState and ODS_COMBOBOXEDIT = 0);
  b2 := ((ds.itemState and ODS_FOCUS <> 0) and not DroppedDown);
  if not SkinData.Skinned or b1 or b2 or DroppedDown then inherited else begin
    with Message.DrawItemStruct^ do BitBlt(hDC, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
  end;
end;

procedure TsCustomComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
var
  ps : TPaintStruct;
  DC : hdc;
begin
{$IFDEF LOGGED}
//  AddToLog(Message);
{$ENDIF}
  if ReadOnly then begin
    case Message.Msg of
      WM_KEYDOWN, WM_CHAR, WM_KEYUP, WM_SYSKEYUP, CN_KEYDOWN, CN_CHAR, CN_SYSKEYDOWN,
        CN_SYSCHAR, WM_PASTE, WM_CUT, WM_CLEAR, WM_UNDO: Exit
      else
{$IFDEF TNTUNICODE}
      if not TntCombo_ComboWndProc(Self, Message, ComboWnd, ComboProc, DoEditCharMsg) then
{$ENDIF}
    end
  end;
{$IFDEF TNTUNICODE}
  if not TntCombo_ComboWndProc(Self, Message, ComboWnd, ComboProc, DoEditCharMsg) then
{$ENDIF}
  begin
    if FCommonData.Skinned then case Message.Msg of
      WM_ERASEBKGND, WM_NCPAINT : if not (Focused or FCommonData.FFocused) or not Enabled or ReadOnly then begin
        if Style = csSimple then inherited;
        Message.Result := 1;
        Exit;
      end;
      WM_PAINT : if not (Focused or FCommonData.FFocused) or not Enabled or ReadOnly then begin
        if Style = csSimple then begin
          inherited;
          Exit;
        end;
        BeginPaint(ComboWnd, PS);
        if not FCommonData.BGChanged then begin
          DC := GetWindowDC(ComboWnd);
          BitBlt(DC, 0, 0, Width - 6, FCommonData.FCacheBmp.Height - 6, FCommonData.FCacheBmp.Canvas.Handle, 3, 3, SRCCOPY);
          ReleaseDC(ComboWnd, DC);
        end;
        EndPaint(ComboWnd, PS);
        Exit;
      end;
    end;
    inherited;
  end;
end;

{$IFDEF TNTUNICODE}
procedure TsCustomComboBox.CopySelection(Destination: TCustomListControl);
begin
  TntComboBox_CopySelection(Items, ItemIndex, Destination);
end;
{$ENDIF}

constructor TsCustomComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  DropDownCount := 16;
{$IFDEF TNTUNICODE}
  FItems := TTntComboBoxStrings.Create;
  TTntComboBoxStrings(FItems).ComboBox := Self;
{$ENDIF}
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsEdit;
  if FCommonData.SkinSection = '' then FCommonData.SkinSection := s_ComboBox;
  FDisabledKind := DefDisabledKind;

  FBoundLabel := TsBoundLabel.Create(Self, FCommonData);
  FDropDown := False;
  Canvas.Handle := 0;

  FButtonMargin := 1;
  FReadOnly := False;
  FShowButton := True;

  FDefListProc := nil;
end;

{$IFDEF TNTUNICODE}
procedure TsCustomComboBox.CreateWindowHandle(const Params: TCreateParams);
begin
  try
    CreateUnicodeHandle(Self, Params, 'COMBOBOX');
  except
    RaiseLastOSError;
  end;
end;