scomboboxes.pas

Alpha Controls.v5.46b Source

    procedure DrawSkinItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    function ImgRect(Item : TsComboItem; State: TOwnerDrawState) : TRect;
    function CurrentImage(Item : TsComboItem; State: TOwnerDrawState) : integer;
  public
    procedure Clear; override;
    procedure UpdateList;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateWnd; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure UpdateMargins; override;
    property Images : TCustomImageList read FImages write SetImages;
    property ItemsEx : TsComboItems read FItemsEx write SetItemsEx;
    property SelectedItem : TsComboItem read GetSelectedItem;
  end;
{$ENDIF} // NOTFORHELP

  TsComboBoxEx = class(TsCustomComboBoxEx)
{$IFNDEF NOTFORHELP}
  public
    property SelectedItem;
  published
    property Action;
    property Anchors;
    property BiDiMode;
    property Color;
    property Constraints;
    property Ctl3D;
    property DisabledKind;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;

    property BevelEdges;
    property BevelInner;
    property BevelKind;
    property BevelOuter;
    property DropDownCount;

    property OnChange;
    property OnCloseUp;
    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 OnSelect;
    property OnStartDock;
    property OnStartDrag;
{$ENDIF} // NOTFORHELP
    property MaxLength;
    property Images;
    property ItemsEx;
    property SkinData;
    property Text;
  end;

{$IFNDEF NOTFORHELP}
var
  ColDlg : TColorDialog;
{$ENDIF} // NOTFORHELP

implementation

uses sStyleSimply, sMaskData, sSkinProps, sVclUtils, Consts, sMessages, sBorders,
  commctrl, sAlphaGraph, sThirdParty, sSKinManager;

const
  StandardColorsCount = 16;
  ExtendedColorsCount = 4;
  NoColorSelected = TColor($FF000000);

type
  TSelection = record
    StartPos, EndPos: Integer;
  end;

function HasPopup(Control: TControl): Boolean;
begin
  Result := True;
  while Control <> nil do
    if TsHackedControl(Control).PopupMenu <> nil then Exit else Control := Control.Parent;
  Result := False;
end;

{ TsCustomListControl }

procedure TsCustomListControl.AfterConstruction;
begin
  inherited;
  SkinData.Loaded;
end;

constructor TsCustomListControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsCustom;
  if FCommonData.SkinSection = '' then FCommonData.SkinSection := s_ComboBOx;
  FBoundLabel := TsBoundLabel.Create(Self, FCommonData);
end;

destructor TsCustomListControl.Destroy;
begin
  FreeAndNil(FBoundLabel);
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  inherited Destroy;
end;

procedure TsCustomListControl.Loaded;
begin
  inherited;
  SkinData.Loaded;
  if FCommonData.Skinned then begin
    if not FCommonData.CustomColor then Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].Color;
    if not FCommonData.CustomFont then Font.Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].FontColor[1];
  end;
end;

procedure TsCustomListControl.MoveSelection(Destination: TsCustomListControl);
begin
  CopySelection(Destination);
  DeleteSelected;
end;

procedure TsCustomListControl.WndProc(var Message: TMessage);
var
  DC : hdc;
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_REMOVESKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      if not FCommonData.CustomColor then Color := clWindow;
      if not FCommonData.CustomFont then Font.Color := clWindowText;
      exit
    end;
    AC_SETNEWSKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
//      Repaint;
      exit
    end;
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      if FCommonData.Skinned then begin
        if not FCommonData.CustomColor then Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].Color;
        if not FCommonData.CustomFont then Font.Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].FontColor[1];
      end;
      Repaint;
      exit
    end;
    AC_ENDPARENTUPDATE : if FCommonData.Updating then begin
      FCommonData.Updating := False;
      Repaint; // v4.11
      Exit
    End; // 407
  end;
  if not ControlIsReady(Self) then inherited else begin
    if Assigned(FCommonData) then begin
      if CommonWndProc(Message, FCommonData) then Exit;
      if FCommonData.Skinned then case Message.Msg of
        WM_NCCALCSIZE, WM_WINDOWPOSCHANGED, CM_VISIBLECHANGED, WM_SIZE, CM_ENABLEDCHANGED, WM_MOUSEWHEEL, WM_MOVE : begin
          FCommonData.BGChanged := True;
        end;
        WM_VSCROLL : begin
          exit;
        end;
        WM_PRINT : begin
          try
            DC := TWMPaint(Message).DC;
            SkinData.Updating := SkinData.Updating;
            if SkinData.Updating then Exit;
            if SkinData.BGChanged then begin
              PrepareCache(SkinData, Handle)
            end;
            UpdateCorners(SkinData, 0);
            try
              BitBltBorder(DC, 0, 0, SkinData.FCacheBmp.Width, SkinData.FCacheBmp.Height, SkinData.FCacheBmp.Canvas.Handle, 0, 0, 2);
              SendMessage(Handle, WM_PAINT, longint(DC), 0);
            finally
            end;
            Exit;
          except
          end;
        end;
      end;
    end;
    inherited;
    if FCommonData.Skinned then case Message.Msg of
      WM_WINDOWPOSCHANGING, WM_WINDOWPOSCHANGED, CM_VISIBLECHANGED, WM_SIZE, CM_ENABLEDCHANGED, WM_MOUSEWHEEL, WM_MOVE : begin
  //        Repaint;
        SendMessage(Handle, WM_NCPAINT, 0, 0);
      end;
      WM_SETFOCUS, CM_ENTER, WM_KILLFOCUS, CM_EXIT: begin
        FCommonData.FFocused := (Message.Msg = CM_ENTER) or (Message.Msg = WM_SETFOCUS);
        FCommonData.FMouseAbove := False;
        FCommonData.BGChanged := True;
        Repaint;
        SendMessage(Handle, WM_NCPAINT, 0, 0);
      end;
      CM_MOUSELEAVE, CM_MOUSEENTER : begin
        if not FCommonData.FFocused and not(csDesigning in ComponentState) then begin
          FCommonData.FMouseAbove := Message.Msg = CM_MOUSEENTER;
          FCommonData.BGChanged := True;
          SendMessage(Handle, WM_NCPAINT, 0, 0);
          Repaint;
        end;
      end;
      WM_SETFONT : begin
        FCommonData.BGChanged := True;
        SendMessage(Handle, WM_NCPAINT, 0, 0);
        Repaint;
      end;
    end;
  end;
  // Aligning of the bound label 
  if Assigned(BoundLabel) and Assigned(BoundLabel.FtheLabel) then case Message.Msg of
    WM_SIZE, WM_WINDOWPOSCHANGED : begin BoundLabel.AlignLabel end;
    CM_VISIBLECHANGED : begin BoundLabel.FtheLabel.Visible := Visible; BoundLabel.AlignLabel end;
    CM_ENABLEDCHANGED : begin BoundLabel.FtheLabel.Enabled := Enabled; BoundLabel.AlignLabel end;
    CM_BIDIMODECHANGED : begin BoundLabel.FtheLabel.BiDiMode := BiDiMode; BoundLabel.AlignLabel end;
  end;
end;

{ TsCommonCombo }

procedure TsCommonCombo.AddItem(Item: String; AObject: TObject);
begin
  Items.AddObject(Item, AObject);
end;

procedure TsCommonCombo.AdjustDropDown;
var
  Count, h: Integer;
begin
  Count := ItemCount;
  if Count > DropDownCount then Count := DropDownCount;
  if Count < 1 then Count := 1;
  FDroppingDown := True;
  try
    h := ItemHeight * Count + Height + 2;
    SetWindowPos(FDropHandle, 0, 0, 0, Width, h, SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_NOREDRAW or SWP_HIDEWINDOW);
  finally
    FDroppingDown := False;
  end;
  SetWindowPos(FDropHandle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_NOREDRAW or SWP_SHOWWINDOW);
end;

function TsCommonCombo.ButtonRect: TRect;
const
  bWidth = 3;
var
  w : integer;
begin
  if FShowButton then w := GetSystemMetrics(SM_CXVSCROLL) + 1 else w := 0;
  if UseRightToLeftAlignment then Result.Left := 2 else Result.Left := Width - w - 2;
  Result.Top := 2;
  Result.Right := Result.Left + w;
  Result.Bottom := Height - 2;
//  if UseRightToLeftAlignment then Result := Rect(bWidth, bWidth, GetSystemMetrics(SM_CXVSCROLL) + bWidth, Height - bWidth) else Result := Rect(Width - GetSystemMetrics(SM_CXVSCROLL) - bWidth, bWidth, Width - bWidth, Height - bWidth);
end;

procedure TsCommonCombo.Change;
var
  R : TRect;
begin
  if csLoading in ComponentState then Exit;
  inherited Changed;
  UpdateMargins;
  if Assigned(FCommonData.SkinManager) and FCommonData.SkinManager.IsValidSkinIndex(FCommonData.SkinIndex) then begin
    R := Classes.Rect(3, 3, Width - 3, Height - 3);
    InvalidateRect(Handle, @R, False);
  end;
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TsCommonCombo.Clear;
begin
  SetTextBuf('');
  FItems.Clear;
  FSaveIndex := -1;
end;

procedure TsCommonCombo.ClearSelection;
begin
  ItemIndex := -1;
end;

procedure TsCommonCombo.CloseUp;
begin
  if Assigned(FOnCloseUp) then FOnCloseUp(Self);
end;

procedure TsCommonCombo.CMCancelMode(var Message: TCMCancelMode);
begin
  if Message.Sender <> Self then Perform(CB_SHOWDROPDOWN, 0, 0);
end;

procedure TsCommonCombo.CMCtl3DChanged(var Message: TMessage);
begin
  if NewStyleControls then RecreateWnd;
  inherited;
end;

procedure TsCommonCombo.CNCommand(var Message: TWMCommand);
begin
  case Message.NotifyCode of
    CBN_DBLCLK : DblClick;
    CBN_EDITCHANGE : Change;
    CBN_DROPDOWN: begin
      FFocusChanged := False;
      DropDown;
      AdjustDropDown;
      if FFocusChanged then begin
        PostMessage(Handle, WM_CANCELMODE, 0, 0);
        if not FIsFocused then PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0);
      end;
    end;
    CBN_SELCHANGE: begin
      Text := Items[ItemIndex];
      try
        Click;
      except
      end;
      Select;
    end;
    CBN_CLOSEUP: begin
      FCommonData.BGChanged := True;
      Repaint;
      CloseUp;
    end;
    CBN_SETFOCUS : begin
      FIsFocused := True;
      FCommonData.FFocused := True;
      FFocusChanged := True;
      SetIme;
    end;
    CBN_KILLFOCUS : begin
      FIsFocused := False;
      FCommonData.FFocused := False;
      FFocusChanged := True;
      ResetIme;
    end;
  end;
end;

procedure TsCommonCombo.CNMeasureItem(var Message: TWMMeasureItem);
begin
  with Message.MeasureItemStruct^ do begin
    itemHeight := FItemHeight;
//    if FStyle = csOwnerDrawVariable then
//      MeasureItem(itemID, Integer(itemHeight));
  end;
end;

procedure TsCommonCombo.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
var
  Point: TPoint;
  Form: TCustomForm;
begin
  try
    with Message do begin
      case Msg of
        WM_SETFOCUS : begin
          Form := GetParentForm(Self);
          if (Form <> nil) and not Form.SetFocusedControl(Self) then Exit;
        end;
        WM_KILLFOCUS :
          if csFocusing in ControlState then Exit;
        WM_KEYDOWN, WM_SYSKEYDOWN: