⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 scomboboxes.pas

📁 Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。
💻 PAS
📖 第 1 页 / 共 5 页
字号:
            ListSW := TacComboListWnd.Create(lboxhandle, nil, SkinData.SkinManager, s_Edit);
          end;
        end;
        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);
  case Message.Msg of
    CN_COMMAND : case TWMCommand(Message).NotifyCode of
      CBN_CLOSEUP : begin
        if ListSW <> nil then ListSW.SkinData.BGChanged := True;
      end;
    end;
  end;
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 Include(State, odDefault);

  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 DrawSkinItem(ds.itemID, ds.rcItem, State)
  end
  else begin
    if ds.itemState and ODS_COMBOBOXEDIT <> 0 then Include(State, odComboBoxEdit);
    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 DrawItem(ds.itemID, ds.rcItem, State)
      else FCanvas.FillRect(ds.rcItem);
    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;
  FStyle := csDropDown;
  FLastTime := 0;
  FAutoComplete := True;
  FDisabledKind := DefDisabledKind;
  FReadOnly := False;
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]);
  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
          DeleteSelectedText
        else
          if (Style in [csDropDown, csSimple]) and (Length(Text) > 0) then
          begin
            SaveText := Text;
            OldText := Copy(SaveText, 1, StartPos - 1);
            SendMessage(Handle, CB_SETCURSEL, -1, 0);
            Text := OldText + Copy(SaveText, EndPos + 1, MaxInt);
            SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(StartPos - 1, StartPos - 1));
            FFilter := Text;
          end
          else
            Delete(FFilter, Length(FFilter), 1);
        Key := #0;
        Change;
      end;
  else
    if FAutoDropDown and not DroppedDown then
      DroppedDown := True;
    if HasSelectedText(StartPos, EndPos) then
    begin
      if SelectItem(Copy(FFilter, 1, StartPos) + Key) then
        Key := #0
    end
    else
      if SelectItem(FFilter + Key) then
        Key := #0;
  end;
end;

procedure TsCommonComboBox.MeasureItem(Index: Integer; var Height: Integer);
begin
  if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Index, Height)
end;

function TsCommonComboBox.SelectItem(const AnItem: String): Boolean;
var
  Idx: Integer;
  ValueChange: Boolean;
begin
  if Length(AnItem) = 0 then begin
    Result := False;
    ItemIndex := -1;
    Change;
    exit;
  end;
  Idx := SendMessage(Handle, CB_FINDSTRING, -1, LongInt(PChar(AnItem)));
  Result := (Idx <> CB_ERR);
  if not Result then exit;
  ValueChange := Idx <> ItemIndex;
  SendMessage(Handle, CB_SETCURSEL, Idx, 0);
  if (Style in [csDropDown, csSimple]) then begin
    Text := AnItem + Copy(Items[Idx], Length(AnItem) + 1, MaxInt);
    SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Length(AnItem), Length(Text)));
  end
  else begin
    ItemIndex := Idx;
    FFilter := AnItem;
  end;
  if ValueChange then begin
    Click;
    Select;
  end;
end;

procedure TsCommonComboBox.SetCharCase(Value: TEditCharCase);
begin
  if FCharCase <> Value then begin
    FCharCase := Value;
    RecreateWnd;
  end;
end;

procedure TsCommonComboBox.SetDisabledKind(const Value: TsDisabledKind);
begin
  if FDisabledKind <> Value then begin
    FDisabledKind := Value;
    FCommonData.Invalidate;
  end;
end;

procedure TsCommonComboBox.SetSelText(const Value: string);
begin
  if FStyle < csDropDownList then begin
    HandleNeeded;
    SendMessage(FEditHandle, EM_REPLACESEL, 0, Longint(PChar(Value)));
  end;
end;

procedure TsCommonComboBox.SetSorted(Value: Boolean);
begin
  if FSorted <> Value then begin
    FSorted := Value;
    RecreateWnd;
  end;
end;

procedure TsCommonComboBox.SetStyle(Value: TComboBoxStyle);
begin
  if FStyle <> Value then begin
    FStyle := Value;
    RecreateWnd;
  end;
end;

procedure TsCommonComboBox.SkinPaint(DC: HDC);
var
  CI : TCacheInfo;
  R : TRect;
  State : TOwnerDrawState;
begin
  FCommonData.InitCacheBmp;
  CI.Ready := False;
  CI := GetParentCache(FCommonData);

  PaintItem(FCommonData, Ci,
    False, integer(ControlIsActive(FCommonData)),
    Rect(0, 0, Width, Height),
    Point(Left, Top),
    SkinData.FCacheBmp, False
  );
  UpdateCorners(FCommonData, 0);
  if FShowButton then PaintButton;
  FCommonData.BGChanged := False;

  if not Enabled then begin
    BmpDisabledKind(FCommonData.FCacheBmp, FDisabledKind, Parent, CI, Point(Left, Top));
  end;

  BitBlt(DC, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);

  R := ClientRect;
  InflateRect(R, -3, -3);

  State := [odComboBoxEdit];
  if FCommonData.FFocused then State := State + [odFocused];
  Canvas.Handle := DC;
  DrawSkinItem(ItemIndex, R, State);
  Canvas.Handle := 0;
end;

procedure TsCommonComboBox.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  if not FCommonData.Skinned then FillDC(Message.DC, ClientRect, Color);
end;

{ v4.15
procedure TsCommonComboBox.WMFontChange(var Message: TMessage);
begin
  FCommonData.BGChanged := true;
  SendMessage(Handle, WM_PAINT, 0, 0);
end;
}
procedure TsCommonComboBox.WMLButtonDblClk(var Message: TMessage);
begin
  if FReadOnly then begin
    SetFocus;
    if Assigned(OnDblClick) then OnDblClick(Self);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -