scomboboxes.pas

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

    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnSelect;
    property OnStartDock;
    property OnStartDrag;
  end;

implementation

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

const
  StandardColorsCount = 16;
  ExtendedColorsCount = 4;

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;
  CommonData.Loaded;
end;

constructor TsCustomListControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsCustom;
end;

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

procedure TsCustomListControl.Loaded;
begin
  inherited;
  CommonData.Loaded;
end;

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

procedure TsCustomListControl.WndProc(var Message: TMessage);
begin
  if not ControlIsReady(Self) then inherited
  else begin
    if Assigned(FCommonData) then begin
      FCommonData.WndProc(Message);
      if FCommonData.Skinned then
        case Message.Msg of
          CM_VISIBLECHANGED, WM_SIZE, CM_ENABLEDCHANGED, WM_MOUSEWHEEL, WM_MOVE : begin
            FCommonData.BGChanged := True;
            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;
          WM_VSCROLL : begin
            exit;
          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;
        end;
    end;
    if Message.Result <> 1 then begin
      inherited;
    end;
    case Message.Msg of
{      WM_SETFOCUS, CM_ENTER, WM_KILLFOCUS, CM_EXIT: begin
        Invalidate;
      end;}
      SM_REMOVESKIN : begin
        FCommonData.SkinIndex := -1;
        FCommonData.BorderIndex := -1;
        Invalidate;
      end;
    end;
  end;
end;

{ TsCommonCombo }

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

procedure TsCommonCombo.AdjustDropDown;
var
  Count: Integer;
begin
  Count := ItemCount;
  if Count > DropDownCount then Count := DropDownCount;
  if Count < 1 then Count := 1;
  FDroppingDown := True;
  try
    SetWindowPos(FDropHandle, 0, 0, 0, Width, ItemHeight * Count +
      Height + 2, 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;
var
  i : integer;
begin
  Result := Rect(0, 0, 0, 0);
  i := GetMaskIndex(FCommonData.SkinIndex, FCommonData.SkinSection, ItemGlyph);
  if IsValidImgIndex(i) then begin
    Result := ClientRect;
    Result.Left := Result.Right - ma[i].Bmp.Width div 3;
    Result.Top := (Result.Bottom - ma[i].Bmp.Height div 2) div 2;
    Result.Bottom := ClientRect.Bottom - Result.Top;
    OffsetRect(Result, - Result.Top, 0);
  end;
end;

procedure TsCommonCombo.Change;
var
  R : TRect;
begin
  inherited Changed;
  UpdateMargins;
  if IsValidSkinIndex(CommonData.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];
      Click;
      Select;
    end;
    CBN_CLOSEUP:
      CloseUp;
    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.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
var
  Point: TPoint;
  Form: TCustomForm;
begin
  try
    with Message do begin
      case Msg of
{        WM_DRAWITEM : begin
          alert;
        end;} 
        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:
          if (ComboWnd <> FListHandle) and DoKeyDown(TWMKey(Message)) then Exit;
        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;
        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 begin
    ControlStyle := ComboBoxStyle;
  end
  else begin
    ControlStyle := ComboBoxStyle + [csFramed];
  end;
  
  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;
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 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