scomboboxes.pas

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

  end
  else inherited;
end;

procedure TsCommonComboBox.WMLButtonDown(var Message: TWMLButtonDown);
var
  Form: TCustomForm;
begin
  if FReadOnly then SetFocus else 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;
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 FCommonData.Skinned then begin
    if not SkinData.CustomColor then Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].HotColor;
    Brush.Style := bsClear;
    DC := Message.DC;
    BeginPaint(Handle, PS);
    if DC = 0 then begin DC := GetWindowDC(Handle); end;
    SavedDC := SaveDC(DC);
    try
      SkinData.Updating := SkinData.Updating;
      if not SkinData.Updating then SkinPaint(DC);
    finally
      RestoreDC(DC, SavedDC);
      if Message.DC = 0 then ReleaseDC(Handle, DC);
      EndPaint(Handle, PS);
    end;
  end
  else begin
    inherited;
    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;
      SendMessage(Handle, WM_NCPAINT, 0, 0);
    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_SYSCHAR, WM_SYSKEYDOWN, CN_SYSCHAR, CN_SYSKEYDOWN, WM_KEYDOWN, CN_KEYDOWN : case TWMKey(Message).CharCode of
      38, 40 : if ReadOnly then Exit;
    end;
    WM_COMMAND, CN_COMMAND : if ReadOnly then Exit;
  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 Result.Right := Result.Bottom - Result.Top + Result.Left
    else Result.Right := Result.Right - WidthOf(ButtonRect) - 3 * integer(FShowButton); 
  if odComboBoxEdit in State
    then InflateRect(Result, - 1 - FMargin, - 1 - FMargin)
    else InflateRect(Result, - 1, - 1);
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;
    if FShowColorName or not (odComboBoxEdit in State)
      then LRect.Right := LRect.Bottom - LRect.Top + LRect.Left
      else LRect.Right := Rect.Right - WidthOf(ButtonRect);
    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;

{KJS ADDED}
    if FShowColorName or not (odComboBoxEdit in State) then {KJS END ADD} 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 * integer(FShowButton);
    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 FCommonData.SkinManager.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
        InflateRect(R, 3, 3);
        BitBlt(Bmp.Canvas.Handle, R.Left, R.Top, WidthOf(R), HeightOf(R), FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
      end;
      Bmp.Canvas.Brush.Color := Colors[Index];
      if ShowcolorName then begin
        R := ColorRect(Rect, State);

        if Bmp.Canvas.Brush.Color = clDefault
          then Bmp.Canvas.Brush.Color := DefaultColorColor
          else if Bmp.Canvas.Brush.Color = clNone then Bmp.Canvas.Brush.Color := NoneColorColor;

        Bmp.Canvas.FillRect(R);
        Bmp.Canvas.Brush.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
        Bmp.Canvas.FrameRect(R);

        Rect.Left := R.Right + 5;

        Bmp.Canvas.Brush.Style := bsClear;
        if (odFocused in state) and FCommonData.SkinManager.gd[FCommonData.SkinIndex].ShowFocus then begin
          Bmp.Canvas.TextRect(Rect, Rect.Left,
            Rect.Top + (Rect.Bottom - Rect.Top - Bmp.Canvas.TextHeight(Items[Index])) div 2,
            Items[Index]);
        end
        else begin
          WriteTextEx(Bmp.Canvas, PChar(Items[Index]), Enabled,
                 Rect, DT_NOPREFIX, FCommonData, ControlIsActive(FCommonData));
        end;
      end
      else begin
        R := ColorRect(Rect, State);

        if Bmp.Canvas.Brush.Color = clDefault then begin
          Bmp.Canvas.Brush.Color := DefaultColorColor
        end
        else if Bmp.Canvas.Brush.Color = clNone then begin
          Bmp.Canvas.Brush.Color := NoneColorColor;
        end;
        Bmp.Canvas.FillRect(R);
        Bmp.Canvas.Brush.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
        Bmp.Canvas.FrameRect(R);
      end;
    end;

    if not Enabled then begin
      CI.Bmp := SkinData.FCacheBmp;
      CI.X := 0;
      CI.Y := 0;
      CI.Ready := True;
      BmpDisabledKind(Bmp, DisabledKind, Parent, CI, Point(aRect.Left, aRect.Top));
    end;
//    BitBlt(Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
    BitBlt(Canvas.Handle, aRect.Left, aRect.Top, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
    FreeAndNil(Bmp);
  end
  else begin
    if odFocused in state then begin
      Canvas.Brush.Color := clHighLight;
      Canvas.Font.Color := clHighlightText;
      Canvas.FillRect(Classes.Rect(R.Left, R.Top, R.Right, R.Bottom));
      DrawFocusRect(Canvas.Handle, Classes.Rect(R.Left, R.Top, R.Right, R.Bottom));
    end
    else begin
      Canvas.Brush.Color := Color;//clWindow; v4.43
      Canvas.FillRect(Rect);
      Canvas.Font.Color := Font.Color;// clWindowText; v4.43
    end;

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

    Canvas.Brush.Color := Colors[Index];
    if Canvas.Brush.Color = clDefault then begin
      Canvas.Brush.Color := DefaultColorColor
    end
    else if Canvas.Brush.Color = clNone then begin
      Canvas.Brush.Color := NoneColorColor;
    end;
{KJS ADDED}
//    if not fShowcolorName then
//       OffsetRect(R,2,0);
{KJS END ADD}

    Canvas.FillRect(R);
    Canvas.Brush.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
    Canvas.FrameRect(R);

    Rect.Left := R.Right + 5;

    Canvas.Brush.Style := bsClear;
 {KJS ADDED}
//    if fShowcolorName then {KJS END ADDED}
   Canvas.TextRect(Rect, Rect.Left,
      Rect.Top + (Rect.Bottom - Rect.Top - Canvas.TextHeight(Items[Index])) div 2,
      Items[Index]);
  end;
end;

function TsCustomColorBox.GetColor(Index: Integer): TColor;
begin
  if Index < 0 then begin
    Result := clNone;
    Exit;
  end;
  Result := TColor(Items.Objects[Index]);
end;

function TsCustomColorBox.GetColorName(Index: Integer): string;
begin
  Result := Items[Index];
end;

function TsCustomColorBox.GetSelected: TColor;
begin
  if HandleAllocated then
    if ItemIndex <> -1 then
      Result := Colors[ItemIndex]
    else
      Result := NoColorSelected
  else
    Result := FSelectedColor;
end;

procedure TsCustomColorBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  FListSelected := False;
  inherited KeyDown(Key, Shift);
end;

procedure TsCustomColorBox.KeyPre