scomboboxes.pas

AlphaControls是一个Delphi标准控件的集合

  SendMessage(Handle, CB_GETEDITSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  Result := Selection.EndPos - Selection.StartPos;
end;

function TsCommonCombo.GetSelStart: Integer;
begin
  SendMessage(Handle, CB_GETEDITSEL, Longint(@Result), 0);
end;

procedure TsCommonCombo.Invalidate;
begin
  inherited;
end;

procedure TsCommonCombo.ListWndProc(var Message: TMessage);
begin
  ComboWndProc(Message, FListHandle, FDefListProc);
end;

procedure TsCommonCombo.Loaded;
begin
  inherited Loaded;
  if FItemIndex <> -1 then SetItemIndex(FItemIndex);
end;

procedure TsCommonCombo.PaintButton;
var
  R : TRect;
  i, Mode : integer;
begin
  i := GetMaskIndex(FCommonData.SkinIndex, FCommonData.SkinSection, ItemGlyph);
  if IsValidImgIndex(i) then begin
    R := ButtonRect;
    if DroppedDown then begin
      Mode := 2;
    end
    else if FCommonData.ControlIsActive then begin
      Mode := 1;
    end
    else Mode := 0;
    PaintRasterGlyph(FCommonData.FCacheBmp, ma[i].Bmp,
                Point(R.Left, R.Top), Mode, ma[i].TransparentColor);
  end;
end;

procedure TsCommonCombo.Select;
begin
  if Assigned(FOnSelect) then begin
    FOnSelect(Self)
  end
  else begin
    Change;
  end;
end;

procedure TsCommonCombo.SelectAll;
begin
  SendMessage(Handle, CB_SETEDITSEL, 0, Integer($FFFF0000));
end;

procedure TsCommonCombo.SetDropDownCount(const Value: Integer);
begin
  FDropDownCount := Value;
end;

procedure TsCommonCombo.SetDroppedDown(Value: Boolean);
var
  R: TRect;
begin
  SendMessage(Handle, CB_SHOWDROPDOWN, Longint(Value), 0);
  R := ClientRect;
  InvalidateRect(Handle, @R, True);
end;

procedure TsCommonCombo.SetItemHeight(Value: Integer);
begin
  if Value > 0 then begin
    FItemHeight := Value;
    if HandleAllocated then SendMessage(Handle, CB_SETITEMHEIGHT, 0, Value);
//    RecreateWnd;
  end;
end;

procedure TsCommonCombo.SetItemIndex(const Value: Integer);
begin
  if csLoading in ComponentState then
    FItemIndex := Value
  else
    if GetItemIndex <> Value then begin
      SendMessage(Handle, CB_SETCURSEL, Value, 0);
      if IsValidSkinIndex(FCommonData.skinIndex) then Repaint;
    end;
end;

procedure TsCommonCombo.SetItems(const Value: TStrings);
begin
  if Assigned(FItems) then
    FItems.Assign(Value)
  else
    FItems := Value;
end;

procedure TsCommonCombo.SetMaxLength(Value: Integer);
begin
  if Value < 0 then Value := 0;
  if FMaxLength <> Value then begin
    FMaxLength := Value;
    if HandleAllocated then SendMessage(Handle, CB_LIMITTEXT, Value, 0);
  end;
end;

procedure TsCommonCombo.SetSelLength(Value: Integer);
var
  Selection: TSelection;
begin
  SendMessage(Handle, CB_GETEDITSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  Selection.EndPos := Selection.StartPos + Value;
  SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos, Selection.EndPos));
end;

procedure TsCommonCombo.SetSelStart(Value: Integer);
var
  Selection: TSelection;
begin
  Selection.StartPos := Value;
  Selection.EndPos := Value;
  SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos, Selection.EndPos));
end;

procedure TsCommonCombo.UpdateMargins;
begin
end;

procedure TsCommonCombo.WMCreate(var Message: TWMCreate);
begin
  inherited;
  if WindowText <> nil then
    SetWindowText(Handle, WindowText);
end;

procedure TsCommonCombo.WMDeleteItem(var Message: TWMDeleteItem);
begin
  DefaultHandler(Message);
end;

procedure TsCommonCombo.WMDrawItem(var Message: TWMDrawItem);
begin
  DefaultHandler(Message);
end;

procedure TsCommonCombo.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  if DroppedDown then Message.Result := Message.Result or DLGC_WANTALLKEYS;
end;

procedure TsCommonCombo.WMMeasureItem(var Message: TWMMeasureItem);
begin
  DefaultHandler(Message);
end;

procedure TsCommonCombo.WndProc(var Message: TMessage);
var
  h : hdc;
begin
    {for auto drag mode, let listbox handle itself, instead of TControl}
  if not (csDesigning in ComponentState) and
       ((Message.Msg = WM_LBUTTONDOWN) or (Message.Msg = WM_LBUTTONDBLCLK)) and
         not Dragging then begin
    if DragMode = dmAutomatic then begin
      if IsControlMouseMsg(TWMMouse(Message)) then Exit;
      ControlState := ControlState + [csLButtonDown];
      Dispatch(Message);  {overrides TControl's BeginDrag}
      Exit;
    end;
  end;
  with Message do begin
    case Msg of
      WM_SIZE : begin
        if FDroppingDown then begin
          DefaultHandler(Message);
          Exit;
        end;
      end;  
      WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC : begin
        {$R-}
        h := WParam;
        {$R+}
        SetTextColor(h, ColorToRGB(Font.Color));
        SetBkColor(h, ColorToRGB(Brush.Color));
        Result := integer(Brush.Handle);
        Exit;
      end;
      WM_CHAR : begin
        if DoKeyPress(TWMKey(Message)) then Exit;
        if ((TWMKey(Message).CharCode = VK_RETURN) or (TWMKey(Message).CharCode = VK_ESCAPE)) and DroppedDown then begin
          DroppedDown := False;
          Exit;
        end;
      end;
    end;
  end;
  inherited WndProc(Message);
end;

{ TsCommonComboBox }

procedure TsCommonComboBox.CMParentColorChanged(var Message: TMessage);
begin
  inherited;
  if not NewStyleControls and (Style < csDropDownList) then Invalidate;
end;

procedure TsCommonComboBox.CNDrawItem(var Message: TWMDrawItem);
var
  State: TOwnerDrawState;
  ds : TDrawItemStruct;
begin
  ds := Message.DrawItemStruct^;
  if ds.hDC = 0 then Exit;
  State := TOwnerDrawState(LongRec(ds.itemState).Lo);
  FCanvas.Handle := ds.hDC;
  FCanvas.Font := Font;
  FCanvas.Brush := Brush;
  if (ds.itemState and ODS_DEFAULT) <> 0 then begin
    Include(State, odDefault);
  end;

  if FCommonData.Skinned then begin
    if ds.itemState and ODS_COMBOBOXEDIT <> 0 then begin
      Exit;
      Include(State, odComboBoxEdit);
    end;
    if Integer(ds.itemID) >= 0 then begin
      DrawSkinItem(ds.itemID, ds.rcItem, State)
    end;
  end
  else begin
    if ds.itemState and ODS_COMBOBOXEDIT <> 0 then begin
      Include(State, odComboBoxEdit);
    end;
    if (Integer(ds.itemID) >= 0) and (odSelected in State) then begin
      FCanvas.Brush.Color := clHighlight;
      FCanvas.Font.Color := clHighlightText
    end
    else begin
      FCanvas.Brush.Color := Color;
      FCanvas.Font.Color := Font.Color;
    end;
    if Integer(ds.itemID) >= 0 then begin
      DrawItem(ds.itemID, ds.rcItem, State)
    end
    else begin
      FCanvas.FillRect(ds.rcItem);
    end;
    if odFocused in State then DrawFocusRect(ds.hDC, ds.rcItem);
  end;
  FCanvas.Handle := 0;
end;

{
procedure TsCommonComboBox.CNMeasureItem(var Message: TWMMeasureItem);
var
  mi : TMeasureItemStruct;
begin
  mi := Message.MeasureItemStruct^;
  mi.itemHeight := FItemHeight;
  if FStyle = csOwnerDrawVariable then MeasureItem(mi.itemID, Integer(mi.itemHeight));
end;
}
constructor TsCommonComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItems := TsComboBoxStrings.Create;
  TsComboBoxStrings(FItems).ComboBox := Self;
//  FItemHeight := 16;
  FStyle := csDropDown;
  FLastTime := 0;
  FAutoComplete := True;
  FDisabledKind := DefDisabledKind;
end;

procedure TsCommonComboBox.CreateParams(var Params: TCreateParams);
const
  ComboBoxStyles: array[TComboBoxStyle] of DWORD = (
    CBS_DROPDOWN, CBS_SIMPLE, CBS_DROPDOWNLIST,
    CBS_DROPDOWNLIST or CBS_OWNERDRAWFIXED,
    CBS_DROPDOWNLIST or CBS_OWNERDRAWVARIABLE);
  CharCases: array[TEditCharCase] of DWORD = (0, CBS_UPPERCASE, CBS_LOWERCASE);
  Sorts: array[Boolean] of DWORD = (0, CBS_SORT);
begin
  inherited CreateParams(Params);
  CreateSubClass(Params, 'COMBOBOX');
  Params.Style := Params.Style or (WS_VSCROLL or CBS_HASSTRINGS or CBS_AUTOHSCROLL) or
             ComboBoxStyles[FStyle] or Sorts[FSorted] or CharCases[FCharCase];
end;

procedure TsCommonComboBox.CreateWnd;
var
  ChildHandle: THandle;
begin
  inherited CreateWnd;
  FDropHandle := Handle;
  if FSaveItems <> nil then begin
    FItems.Assign(FSaveItems);
    FSaveItems.Free;
    FSaveItems := nil;
    if FSaveIndex <> -1 then begin
      if FItems.Count < FSaveIndex then FSaveIndex := Items.Count;
      SendMessage(Handle, CB_SETCURSEL, FSaveIndex, 0);
    end;
  end;
  if FStyle in [csDropDown, csSimple] then begin
    ChildHandle := GetWindow(Handle, GW_CHILD);
    if ChildHandle <> 0 then begin
      if FStyle = csSimple then begin
        FListHandle := ChildHandle;
        FDefListProc := Pointer(GetWindowLong(FListHandle, GWL_WNDPROC));
        SetWindowLong(FListHandle, GWL_WNDPROC, Longint(FListInstance));
        ChildHandle := GetWindow(ChildHandle, GW_HWNDNEXT);
      end;
      FEditHandle := ChildHandle;
      FDefEditProc := Pointer(GetWindowLong(FEditHandle, GWL_WNDPROC));
      SetWindowLong(FEditHandle, GWL_WNDPROC, Longint(FEditInstance));
    end;
  end;
  if NewStyleControls and (FEditHandle <> 0) then
    SendMessage(FEditHandle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
end;

destructor TsCommonComboBox.Destroy;
begin
  FItems.Free;
  FSaveItems.Free;
  inherited Destroy;
end;

procedure TsCommonComboBox.DestroyWnd;
begin
  if FItems.Count > 0 then begin
    FSaveIndex := ItemIndex;
    FSaveItems := TStringList.Create;
    FSaveItems.Assign(FItems);
  end;
  inherited DestroyWnd;
end;

procedure TsCommonComboBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  TControlCanvas(FCanvas).UpdateTextFlags;
  if Assigned(FOnDrawItem) then FOnDrawItem(Self, Index, Rect, State)
  else begin
    FCanvas.FillRect(Rect);
    FCanvas.TextOut(Rect.Left + 2, Rect.Top, Items[Index]);
//    Alert;
  end;
end;

procedure TsCommonComboBox.DrawSkinItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin

end;

function TsCommonComboBox.GetItemCount: Integer;
begin
  Result := FItems.Count;// - 2;
end;

function TsCommonComboBox.GetItemHt: Integer;
begin
  if FStyle in [csOwnerDrawFixed, csOwnerDrawVariable] then
    Result := FItemHeight else
    Result := Perform(CB_GETITEMHEIGHT, 0, 0);
end;

function TsCommonComboBox.GetItemsClass: TsCustomComboBoxStringsClass;
begin
  Result := TsComboBoxStrings;
end;

function TsCommonComboBox.GetSelText: string;
begin
  Result := '';
  if FStyle < csDropDownList then Result := Copy(Text, GetSelStart + 1, GetSelLength);
end;

procedure TsCommonComboBox.KeyPress(var Key: Char);

  function HasSelectedText(var StartPos, EndPos: DWORD): Boolean;
  begin
    SendMessage(Handle, CB_GETEDITSEL, Integer(@StartPos), Integer(@EndPos));
    Result := EndPos > StartPos;
  end;

  procedure DeleteSelectedText;
  var
    StartPos, EndPos: DWORD;
    OldText: String;
  begin
    OldText := Text;
    SendMessage(Handle, CB_GETEDITSEL, Integer(@StartPos), Integer(@EndPos));
    Delete(OldText, StartPos + 1, EndPos - StartPos);
    SendMessage(Handle, CB_SETCURSEL, -1, 0);
    Text := OldText;
    SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(StartPos, StartPos));
  end;

var
  StartPos: DWORD;
  EndPos: DWORD;
  OldText: String;
  SaveText: String;
begin
  inherited KeyPress(Key);
  if not AutoComplete then exit;
  if Style in [csDropDown, csSimple] then
    FFilter := Text
  else
  begin
   if GetTickCount - FLastTime >= 500 then
      FFilter := '';
    FLastTime := GetTickCount;
  end;
  case Ord(Key) of
    VK_ESCAPE: exit;
    VK_TAB:
      if FAutoDropDown and DroppedDown then
        DroppedDown := False;
    VK_BACK:
      begin
        if HasSelectedText(StartPos, EndPos) then