scomboboxes.pas

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

               (TWMKey(Message).CharCode = VK_ESCAPE)) and DroppedDown then begin
            DroppedDown := False;
            Exit;
          end;
        end;
        WM_KEYUP, WM_SYSKEYUP : if DoKeyUp(TWMKey(Message)) then Exit;
        WM_MOUSEMOVE : Application.HintMouseMessage(Self, Message);
        WM_RBUTTONUP : if HasPopup(Self) then begin
          with TWMRButtonUp(Message) do begin
            Point.X := Pos.X;
            Point.Y := Pos.Y;
            MapWindowPoints(ComboWnd, Handle, Point, 1);
            Pos.X := Point.X;
            Pos.Y := Point.Y;
          end;
          WndProc(Message);
          Exit;
        end;
        WM_GETDLGCODE : if DroppedDown then begin
          Result := DLGC_WANTALLKEYS;
          Exit;
        end;
        WM_NCHITTEST : if csDesigning in ComponentState then begin
          Result := HTTRANSPARENT;
          Exit;
        end;
        CN_KEYDOWN, CN_CHAR, CN_SYSKEYDOWN, CN_SYSCHAR : begin
          WndProc(Message);
          Exit;
        end;
      end;
      Result := CallWindowProc(ComboProc, ComboWnd, Msg, WParam, LParam);
      if (Msg = WM_LBUTTONDBLCLK) and (csDoubleClicks in ControlStyle) then DblClick;
    end;
  except
    Application.HandleException(Self);
  end;
end;

procedure TsCommonCombo.CopySelection(Destination: TsCustomListControl);
begin
  if ItemIndex <> -1 then Destination.AddItem(Items[ItemIndex], Items.Objects[ItemIndex]);
end;

constructor TsCommonCombo.Create(AOwner: TComponent);
const
  ComboBoxStyle = [csCaptureMouse, csSetCaption, csDoubleClicks, csFixedHeight, csReflector, csOpaque];
begin
  inherited Create(AOwner);

  if NewStyleControls then ControlStyle := ComboBoxStyle else ControlStyle := ComboBoxStyle + [csFramed];

  Width := 145;
  TabStop := True;
  ParentColor := False;
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
  FItemHeight := 16;
  FEditInstance := MakeObjectInstance(EditWndProc);
  FListInstance := MakeObjectInstance(ListWndProc);
  FDropDownCount := 14;
  FItemIndex := -1;
  FSaveIndex := -1;
  FShowButton := True;
  Height := 22;
end;

procedure TsCommonCombo.CreateWnd;
begin
  inherited CreateWnd;
  SendMessage(Handle, CB_LIMITTEXT, FMaxLength, 0);
  FEditHandle := 0;
  FListHandle := 0;
end;

procedure TsCommonCombo.DeleteSelected;
begin
  if ItemIndex <> -1 then Items.Delete(ItemIndex);
end;

destructor TsCommonCombo.Destroy;
begin
  if lBoxHandle <> 0 then begin
    UninitializeACScroll(lBoxHandle, True, False, ListSW);
    lBoxHandle := 0;
  end;
  if HandleAllocated then DestroyWindowHandle;
  FreeObjectInstance(FListInstance);
  FreeObjectInstance(FEditInstance);
  FCanvas.Free;
  inherited Destroy;
end;

procedure TsCommonCombo.DestroyWindowHandle;
begin
  inherited DestroyWindowHandle;
  {
    must be cleared after the main handle is destroyed as messages are sent
    to our internal WndProcs when the main handle is destroyed and we should not
    have NULL handles when we receive those messages.
  }
  FEditHandle := 0;
  FListHandle := 0;
  FDropHandle := 0;
end;

procedure TsCommonCombo.DropDown;
begin
  if Assigned(FOnDropDown) then FOnDropDown(Self);
end;

procedure TsCommonCombo.EditWndProc(var Message: TMessage);
var
  P: TPoint;
  Form: TCustomForm;
begin
  if Message.Msg = WM_SYSCOMMAND then begin
    WndProc(Message);
    Exit;
  end
  else if (Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST) then begin
    Form := GetParentForm(Self);
    if (Form <> nil) and Form.WantChildKey(Self, Message) then Exit;
  end;
  ComboWndProc(Message, FEditHandle, FDefEditProc);
  case Message.Msg of
    WM_LBUTTONDOWN, WM_LBUTTONDBLCLK : begin
      if DragMode = dmAutomatic then begin
        GetCursorPos(P);
        P := ScreenToClient(P);
        SendMessage(FEditHandle, WM_LBUTTONUP, 0,Longint(PointToSmallPoint(P)));
        BeginDrag(False);
      end;
    end;

    WM_SETFONT : if NewStyleControls then begin
      SendMessage(FEditHandle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
    end;
  end;
end;

function TsCommonCombo.Focused: Boolean;
var
  FocusedWnd: HWND;
begin
  Result := False;
  if HandleAllocated then begin
    FocusedWnd := GetFocus;
    Result := (FocusedWnd <> 0) and ((FocusedWnd = FEditHandle) or (FocusedWnd = FListHandle));
  end;
end;

function TsCommonCombo.GetCount: Integer;
begin
  Result := GetItemCount;
end;

function TsCommonCombo.GetDroppedDown: Boolean;
begin
  Result := LongBool(SendMessage(Handle, CB_GETDROPPEDSTATE, 0, 0));
end;

function TsCommonCombo.GetItemIndex: Integer;
begin
  if csLoading in ComponentState then begin
    Result := FItemIndex
  end
  else begin
    Result := SendMessage(Handle, CB_GETCURSEL, 0, 0);
  end;
end;

function TsCommonCombo.GetSelLength: Integer;
var
  Selection: TSelection;
begin
  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.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.MeasureItem(Index: Integer; var Height: Integer);
begin
  if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Index, Height)
end;

procedure TsCommonCombo.PaintButton;
var
  R : TRect;
  Mode : integer;
  c : TsColor;
  glIndex : integer;
  ButtonHeight : integer;
  TmpBtn : TBitmap;
begin
  if DroppedDown then Mode := 2 else if ControlIsActive(FCommonData) then Mode := 1 else Mode := 0;
  R := ButtonRect;

  if FCommonData.SkinManager.ConstData.ComboBtnIndex > -1 then begin
    TmpBtn := CreateBmpLike(FCommonData.FCacheBmp);
    BitBlt(TmpBtn.Canvas.Handle, 0, 0, TmpBtn.Width, TmpBtn.Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
    PaintItem(FCommonData.SkinManager.ConstData.ComboBtnIndex, s_ComboBtn, MakeCacheInfo(TmpBtn),
      True, Mode, R, Point(0, 0), FCommonData.FCacheBmp, FCommonData.SkinManager, FCommonData.SkinManager.ConstData.ComboBtnBG, FCommonData.SkinManager.ConstData.ComboBtnBGHot);
    FreeAndNil(TmpBtn);
  end;
  glIndex := FCommonData.SkinManager.ConstData.ComboGlyph;
  if glIndex > -1 then begin
    if ControlIsActive(FCommonData)
      then c.C := FCommonData.SkinManager.gd[FCommonData.SkinIndex].HotColor
      else c.C := FCommonData.SkinManager.gd[FCommonData.SkinIndex].Color;

    ButtonHeight := HeightOf(FCommonData.SkinManager.ma[glIndex].R) div (1 + FCommonData.SkinManager.ma[glIndex].MaskType);

    DrawSkinGlyph(FCommonData.FCacheBmp,
      Point(R.Left + (WidthOf(R) - WidthOf(FCommonData.SkinManager.ma[glIndex].R) div FCommonData.SkinManager.ma[glIndex].ImageCount) div 2,
            (Height - ButtonHeight) div 2), Mode, 1, FCommonData.SkinManager.ma[FCommonData.SkinManager.ConstData.ComboGlyph]);
  end;
{
var
  R : TRect;
  i, Mode, x, y : integer;
begin
  i := FCommonData.SkinManager.GetMaskIndex(FCommonData.SkinIndex, FCommonData.SkinSection, s_ItemGlyph);
  if FCommonData.SkinManager.IsValidImgIndex(i) then begin
    R := ButtonRect;
    if DroppedDown then Mode := 2 else if ControlIsActive(FCommonData) then Mode := 1 else Mode := 0;
    x := WidthOf(FCommonData.SkinManager.ma[i].R) div FCommonData.SkinManager.ma[i].ImageCount;
    y := HeightOf(FCommonData.SkinManager.ma[i].R) div (1 + FCommonData.SkinManager.ma[i].MaskType);
    x := (WidthOf(R) - x) div 2;
    y := (HeightOf(R) - y) div 2;
    DrawSkinGlyph(FCommonData.FCacheBmp, Point(R.Left + x, R.Top + y), Mode, 1, FCommonData.SkinManager.ma[i]);
  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 Assigned(FCommonData.SkinManager) and FCommonData.SkinManager.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.SetShowButton(const Value: boolean);
begin
  if FShowButton <> Value then begin
    FShowButton := Value;
    FCommonData.Invalidate;
  end;
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.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 := hdc(WParam);
        {$R+}
        if (Message.Msg = WM_CTLCOLORLISTBOX) and SkinData.Skinned and not (csLoading in ComponentState) and (lBoxHandle = 0) then begin
          if Items.Count > DropDownCount then begin
            lBoxHandle := hwnd(Message.LParam);
//            SetWindowLong(lBoxHandle, GWL_STYLE, GetWindowLong(lBoxHandle, GWL_STYLE) and not WS_BORDER or WS_THICKFRAME);