scomboboxes.pas

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

          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.SkinIndex,
               FCommonData.SkinSection, Ci,
               False, integer(FCommonData.ControlIsActive),
               Rect(0, 0, Width, Height),
               Point(Left, Top),
               CommonData.FCacheBmp
  );
  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 FCommonData.Skinned then begin
    Message.Result := 1;
  end
  else begin
    if Style = csSimple then begin
      FillRect(Message.DC, ClientRect, Parent.Brush.Handle);
      Message.Result := 1;
    end
    else
    DefaultHandler(Message);
    inherited;
  end;
end;

procedure TsCommonComboBox.WMLButtonDown(var Message: TWMLButtonDown);
var
  Form: TCustomForm;
begin
  if (DragMode = dmAutomatic) and (Style = csDropDownList) and
       (Message.XPos < (Width - GetSystemMetrics(SM_CXHSCROLL))) then begin
    SetFocus;
    BeginDrag(False);
    Exit;
  end;
  inherited;
  if MouseCapture then begin
    Form := GetParentForm(Self);
    if (Form <> nil) and (Form.ActiveControl <> Self) then MouseCapture := False;
  end;
end;

{
procedure TsCommonComboBox.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
end;
}
procedure TsCommonComboBox.WMPaint(var Message: TWMPaint);
const
  InnerStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENINNER, BDR_RAISEDINNER, 0);
  OuterStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENOUTER, BDR_RAISEDOUTER, 0);
  EdgeStyles: array[TBevelKind] of Integer = (0, 0, BF_SOFT, BF_FLAT);
  Ctl3DStyles: array[Boolean] of Integer = (BF_MONO, 0);
var
  EdgeSize: Integer;
  WinStyle: Longint;
  C: TControlCanvas;
  R: TRect;
  PS: TPaintStruct;
  DC : hdc;
  SavedDC: hdc;
begin
  if not ControlIsReady(Self) then Exit;
  if FCommonData.Skinned then begin
    Color := gd[FCommonData.SkinIndex].HotPaintingColor;
    Brush.Style := bsClear;
  end
  else inherited;
  if FCommonData.Skinned then begin
    DC := Message.DC;
    if DC = 0 then begin DC := BeginPaint(Handle, PS); end;
    SavedDC := SaveDC(DC);
    try
      SkinPaint(DC);
    finally
      RestoreDC(DC, SavedDC);
      if Message.DC = 0 then EndPaint(Handle, PS);
    end;
  end
  else begin
    if BevelKind = bkNone then Exit;
    C := TControlCanvas.Create;
    try
    C.Control := Self;
    R := ClientRect;
    C.Brush.Color := Color;
    C.FillRect(R);
    C.FrameRect(R);
    InflateRect(R,-1,-1);
    C.FrameRect(R);
    if BevelKind <> bkNone then begin
      EdgeSize := 0;
      if BevelInner <> bvNone then Inc(EdgeSize, BevelWidth);
      if BevelOuter <> bvNone then Inc(EdgeSize, BevelWidth);
      if EdgeSize = 0 then begin
        R := ClientRect;
        C.Brush.Color := Color;
        C.FrameRect(R);
        InflateRect(R,-1,-1);
        C.FrameRect(R);
      end;
      R := ClientRect;
      with BoundsRect do begin
        WinStyle := GetWindowLong(Handle, GWL_STYLE);
        if beLeft in BevelEdges then Dec(Left, EdgeSize);
        if beTop in BevelEdges then Dec(Top, EdgeSize);
        if beRight in BevelEdges then Inc(Right, EdgeSize);
        if (WinStyle and WS_VSCROLL) <> 0 then Inc(Right, GetSystemMetrics(SM_CYVSCROLL));
        if beBottom in BevelEdges then Inc(Bottom, EdgeSize);
        if (WinStyle and WS_HSCROLL) <> 0 then Inc(Bottom, GetSystemMetrics(SM_CXHSCROLL));
      end;
      DrawEdge(C.Handle, R, InnerStyles[BevelInner] or OuterStyles[BevelOuter], Byte(BevelEdges) or EdgeStyles[BevelKind] or Ctl3DStyles[Ctl3D] or BF_ADJUST);
      R.Left := R.Right - GetSystemMetrics(SM_CXHTHUMB) - 1;
      if DroppedDown then begin
        DrawFrameControl(C.Handle, R, DFC_SCROLL, DFCS_FLAT or DFCS_SCROLLCOMBOBOX)
      end
      else begin
        DrawFrameControl(C.Handle, R, DFC_SCROLL, DFCS_FLAT or DFCS_SCROLLCOMBOBOX);
      end;
    end;
    finally
      C.Free;
    end;
  end;
end;

procedure TsCommonComboBox.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC : if not NewStyleControls and (Style < csDropDownList) then begin
      Message.Result := Parent.Brush.Handle;
      Exit;
    end;
    WM_SIZE : begin
      if not FDroppingDown then begin
        FCommonData.RegionChanged := True;
      end;
    end;
  end;
  inherited WndProc(Message);
end;

{ TsCustomColorBox }

procedure TsCustomColorBox.CloseUp;
begin
  inherited CloseUp;
  FListSelected := True;
end;

procedure TsCustomColorBox.ColorCallBack(const AName: string);
var
  I, LStart: Integer;
  LColor: TColor;
  LName: string;
begin
  LColor := StringToColor(AName);
  if cbPrettyNames in Style then begin
    if Copy(AName, 1, 2) = 'cl'
      then LStart := 3
        else LStart := 1;
    LName := '';
    for I := LStart to Length(AName) do begin
      case AName[I] of
        'A'..'Z': if LName <> '' then LName := LName + ' ';
      end;
      LName := LName + AName[I];
    end;
  end
  else LName := AName;
  Items.AddObject(LName, TObject(LColor));
end;

function TsCustomColorBox.ColorRect(SourceRect : TRect; State: TOwnerDrawState): TRect;
begin
  Result := SourceRect;
  if ShowColorName then begin
    Result.Right := Result.Bottom - Result.Top + Result.Left;
  end
  else begin
    Result.Right := Result.Right - WidthOf(ButtonRect) - 3;
  end;
  if odComboBoxEdit in State then begin
    InflateRect(Result, - 1 - FMargin, - 1 - FMargin);
  end
  else begin
    InflateRect(Result, - 1, - 1);
  end;
end;

constructor TsCustomColorBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  inherited Style := csOwnerDrawFixed;
  FStyle := [cbStandardColors, cbExtendedColors, cbSystemColors];
  FSelectedColor := clBlack;
  FDefaultColorColor := clBlack;
  FShowColorName := True;
  FNoneColorColor := clBlack;
  FCommonData.COC := COC_TsColorBox;
  PopulateList;
end;

procedure TsCustomColorBox.CreateWnd;
begin
  inherited CreateWnd;
  if FNeedToPopulate then PopulateList;
end;

procedure TsCustomColorBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
  function ColorToBorderColor(AColor: TColor): TColor;
  type
    TColorQuad = record
      Red,
      Green,
      Blue,
      Alpha: Byte;
    end;
  begin
    if (TColorQuad(AColor).Red > 192) or
       (TColorQuad(AColor).Green > 192) or
       (TColorQuad(AColor).Blue > 192) then
      Result := clBlack
    else if odSelected in State then
      Result := clWhite
    else
      Result := AColor;
  end;
var
  LRect: TRect;
  LBackground: TColor;
begin
  with Canvas do begin
    FillRect(Rect);
    LBackground := Brush.Color;

    LRect := Rect;
    LRect.Right := LRect.Bottom - LRect.Top + LRect.Left;
    InflateRect(LRect, -1, -1);


    Brush.Color := Colors[Index];
    if Brush.Color = clDefault then Brush.Color := DefaultColorColor else if Brush.Color = clNone then Brush.Color := NoneColorColor;
    FillRect(LRect);
    Brush.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
    FrameRect(LRect);

    Brush.Color := LBackground;
    Rect.Left := LRect.Right + 5;

    TextRect(Rect, Rect.Left, Rect.Top + (Rect.Bottom - Rect.Top - TextHeight(Items[Index])) div 2, Items[Index]);
  end;
end;

procedure TsCustomColorBox.DrawSkinItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  R, aRect : TRect;
  Bmp : TBitmap;
  CI : TCacheInfo;
  function ColorToBorderColor(AColor: TColor): TColor; begin
    if (TsColor(AColor).R > 192) or (TsColor(AColor).G > 192) or (TsColor(AColor).B > 192) then
      Result := clBlack
    else if odSelected in State then
      Result := clWhite
    else
      Result := AColor;
  end;
begin
  R := Rect;
  aRect := Rect;
  Canvas.Brush.Style := bsSolid;
  if odComboBoxEdit in State then begin // if editor window ...
    OffsetRect(R, - R.Left, - R.Top);
    OffsetRect(Rect, - Rect.Left, - Rect.Top);
    R.Right := R.Right - WidthOf(ButtonRect) - 3;
    Bmp := TBitmap.Create;
    Bmp.Width := WidthOf(R);
    Bmp.Height := HeightOf(R);
    Bmp.PixelFormat := pf24bit;

    BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, FCommonData.FCacheBmp.Canvas.Handle, aRect.Left, aRect.Top, SRCCOPY);

    with Bmp do begin
      if odFocused in state then begin
        if gd[FCommonData.SkinIndex].ShowFocus then begin
          if ShowcolorName then begin
            Bmp.Canvas.Brush.Color := clHighLight;
            Bmp.Canvas.Font.Color := clHighlightText;
            R := Classes.Rect(ColorRect(Rect, State).Right + 3, R.Top + 1, R.Right - 3, R.Bottom - 1);
            Bmp.Canvas.FillRect(R);
          end;
          DrawFocusRect(Bmp.Canvas.Handle, R);
        end;
      end
      else begin