scustomcombobox.pas

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

unit sCustomComboBox;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ToolWin, ExtCtrls, sConst, sUtils, sGraphUtils,
  sGlyphUtils, math, sStyleEdits;

Type

  TsCustomComboBox = class(TCustomComboBox)
  private
    FAlignment : TAlignment;
    FGlyphMode: TsGlyphMode;
    FButtonMargin: integer;

    function ButtonRect: TRect;
    procedure CNCommand (var Message: TWMCommand); message CN_COMMAND;
    procedure WMPaint (var Message: TWMPaint); message WM_PAINT;
    procedure WMNCPaint (var Message: TWMPaint); message WM_NCPAINT;

    procedure SetAlignment(const Value: TAlignment);
    procedure SetButtonMargin(const Value: integer);
  protected

    FActive : boolean;
    FCharsInCode : integer;
    FsStyle : TsStyle;
    FUseItemIndex : boolean;
    BorderStyle : TFormBorderStyle;
    FDefBmpName : string;

    procedure DropDown; override;
    function GetClientRect: TRect; override;
    procedure SetActive(Value : boolean);

    procedure WndProc (var Message: TMessage); override;
    procedure CreateWnd; override;
    function Generate : integer; virtual;
  public
    FChildHandle: HWND;
    FDefListProc: Pointer;
    FListHandle: HWND;
    FListInstance: Pointer;
    FDropDown : boolean;

    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;

    property Color;
    function IndexOfKod(s : string) : integer;
    function IndexOf(s : string) : integer;
    procedure Invalidate; override;
    function GetCurrentKod : integer;
    function GetCurrentName : string;

    procedure PaintButton;
    function ButtonWidth : integer;
    function ButtonHeight : integer;

    procedure RedrawBorders;
    procedure WriteText;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    property Alignment : TAlignment read FAlignment write SetAlignment;
    property CharsInCode:integer read FCharsInCode write FCharsInCode;
    property UseItemIndex : boolean read FUseItemIndex write FUseItemIndex;
    property Active:boolean read FActive write SetActive;
    property ButtonMargin : integer read FButtonMargin write SetButtonMargin default 3;
    function Focused: Boolean; override;
  published

    property Anchors;
    property ItemIndex default -1;
    property Enabled;
    property Font;
    property Hint;
    property ItemHeight;
    property Items;
    property MaxLength;
    property DropDownCount default 16;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property Style;
    property TabOrder;
    property Text;
    property Visible;
    property CharCase;
    property sStyle:TsStyle read FsStyle write FsStyle;
    property GlyphMode : TsGlyphMode read FGlyphMode write FGlyphMode;

    property OnChange;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDock;
    property OnEndDrag;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseUp;
    property OnMeasureItem;
    property OnStartDock;
    property OnStartDrag;
    property OnEnter;
    property OnExit;
    { Published declarations }
  end;

  TsComboBox = class(TsCustomComboBox)
  public
    constructor Create(AOwner:TComponent); override;
  published
  end;

var
  COMBO, bTemp : TBitmap;

implementation

uses sStyleSimply, sMaskData, sSkinProps, sVclUtils;

constructor TsCustomComboBox.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csFixedHeight, csFramed] + [csOpaque];
  TControlCanvas(Canvas).Control := self;
  FDropDown := False;

  ParentColor := False;

  FsStyle := TsStyle.Create(Self);
  FsStyle.COC := COC_TsCustomComboBox;
  FButtonMargin := 3;

  FDefBmpName := 'SCO1';
  FGlyphMode := TsGlyphMode.Create(Self);

  OnKeyDown := sStyle.OnKeyDown;
  FDefListProc := nil;
  ItemHeight := 13;

  CharsInCode := 0;
  UseItemIndex := False;
  DropDownCount := 16;
  DoubleBuffered := True;
end;

destructor TsCustomComboBox.Destroy;
begin
  if Assigned(FsStyle) then FreeAndNil(FsStyle);
  if Assigned(FGlyphMode) then FreeAndNil(FGlyphMode);
  inherited Destroy;
end;

function TsCustomComboBox.GetCurrentKod : integer;
begin
  Result := -1;
  if Active and (CharsInCode>0) and (Text <> '') then begin
    try
      Result := StrToInt(copy(Text, 1, CharsInCode));
    except
    end;
  end;
end;

function TsCustomComboBox.IndexOfKod(s : string) : integer;
var
  i : integer;
begin
  Result := -1;
  for i := 0 to Items.Count - 1 do begin
    if Items[i] = s then begin
      Result := i;
      Break;
    end;
  end;
end;

function TsCustomComboBox.GetCurrentName : string;
begin
  if CharsInCode > 0 then begin
    Result := copy(Text, CharsInCode + 4, Length(Text) - CharsInCode - 3);
  end
  else begin
    Result := Text;
  end;
end;

procedure TsCustomComboBox.SetActive(Value : boolean);
begin
  if Value then begin
    FActive := (Generate > 0);
  end
  else begin
    FActive := False;
  end;
end;

procedure TsCustomComboBox.WMPaint(var Message: TWMPaint);
var
  R, bR: TRect;
  DC: HDC;
  PS: TPaintStruct;
  WinBrush: HBRUSH;
begin
  if not ControlIsReady(Self) then Exit;
  if (csDropDown = Style) or (csDropDownList = Style) then begin
    Color := sStyle.GetActiveColor;
    DC := BeginPaint(Handle, PS);
    WinBrush := CreateSolidBrush(ColorToRGB(sStyle.GetActiveColor));
    try
      R := PS.rcPaint;
      R.Right := min(Width - 1, R.Right);

      FillRect(DC, R, WinBrush);
      bR := ButtonRect;

      if IntersectRect(bR, bR, PS.rcPaint) then PaintButton;

      ExcludeClipRect(DC, Width - ButtonWidth - 2, 0, Width, Height);
    finally
      EndPaint(Handle, PS);
      DeleteObject(WinBrush);
    end;
    RedrawBorders;
    Message.Result := 1;
  end
  else inherited;
end;

function TsCustomComboBox.ButtonRect: TRect;
var
  i : integer;
begin
  i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, ComboBoxGlyph);
  if not IsValidImgIndex(i) then begin
    if GlyphMode.UseDefaultGlyph or (GlyphMode.Glyph.Width < 1) then begin
      bTemp := COMBO;
    end
    else begin
      bTemp := GlyphMode.Glyph;
    end;
  end;
  Result := Rect(Width - ButtonWidth - ButtonMargin,
                 (Height - ButtonHeight) div 2,
                 Width - ButtonMargin,
                 Height - (Height - ButtonHeight) div 2);
end;

// Button drawing
procedure TsCustomComboBox.PaintButton;
var
  b : TBitmap;
  R : TRect;
  c : TsColor;
  tc : TColor;
  i : integer;
  function CurrentMaskRect : TRect; begin
    if DroppedDown then begin
      Result := Rect(2 * ButtonWidth, 0, 3 * ButtonWidth, ButtonHeight);
    end
    else if sStyle.ControlIsActive then begin
      Result := Rect(ButtonWidth, 0, 2 * ButtonWidth, ButtonHeight);
    end
    else begin
      Result := Rect(0, 0, ButtonWidth, ButtonHeight);
    end;
  end;
begin
  c.C := sStyle.GetActiveColor;

  // Painting on the bitmap B
  b := TBitmap.Create;
  try
    R := ButtonRect;

    b.PixelFormat := pf24Bit;
    b.Width := ButtonWidth;
    b.Height := ButtonHeight;

    b.Canvas.Brush.Color := c.c;
    b.Canvas.FillRect(Rect(0, 0, b.Width, b.Height));


    i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, ComboBoxGlyph);
    if IsValidImgIndex(i) then begin
      tc := ma[i].Bmp.Canvas.Pixels[0, ma[i].Bmp.Height - 1];
      CopyByMask(
                 Rect(0, 0, ma[i].Bmp.Width - 1, ma[i].Bmp.Height - 1),
                 CurrentMaskRect,
                 b,
                 ma[i].Bmp, EmptyCI);
    end
    else begin
      tc := bTemp.Canvas.Pixels[0, bTemp.Height - 1];
      CopyByMask(
                 Rect(0, 0, bTemp.Width - 1, bTemp.Height - 1),
                 CurrentMaskRect,
                 b,
                 bTemp, EmptyCI);
    end;

    tc := b.Canvas.Pixels[0, b.Height - 1];
    if Enabled then begin
      if not sStyle.ControlIsActive then begin
        if GlyphMode.Grayed then begin
          GrayScaleTrans(b, TsColor(tc));
        end;
        if GlyphMode.Blend > 0 then begin
          BlendTransBitmap(b, GlyphMode.Blend / 100, c, TsColor(tc));
        end;
      end;
    end
    else begin
      BlendTransBitmap(b, 0.75, c, TsColor(tc));
    end;


    R := ButtonRect;

    tc := b.Canvas.Pixels[0, b.Height - 1];
    Canvas.Draw(R.Left, R.Top, b);
  finally
    FreeAndNil(b);
  end;
end;


procedure TsCustomComboBox.CNCommand(var Message: TWMCommand);
begin
  Case Message.NotifyCode of
    CBN_CLOSEUP: begin
      DroppedDown := False;
    end;
  end;
  inherited;
end;

procedure TsCustomComboBox.RedrawBorders;
var
  R: TRect;
  c : TColor;
begin
  c := sStyle.GetActiveColor;
  if (Focused or sStyle.FFocused) then begin
    R := GetClientRect;
    InflateRect(R, 1, 1);
    dec(R.Top);
    dec(R.Left);
    R.Right := R.Right - WidthOf(ButtonRect);

    if Style = csDropDownList then begin
      Canvas.Brush.Color := clHighlight;
      Canvas.FillRect(Rect(R.Left + 1, R.Top + 1, R.Right - 1, R.Bottom + 1));
      Canvas.Font.Color := clHighlightText;
      Canvas.Brush.Style := bsClear;
      Canvas.TextRect(R, R.Left + 2, R.Top + 2, Text);
    end
    else begin
      Canvas.Brush.Color := C;
      Canvas.FillRect(R);
      Canvas.TextRect(R, R.Left + 2, R.Top + 1, Text);
    end;
  end
  else begin
    WriteText;
  end;
  sStyle.RedrawBorder;
  if (Focused or sStyle.FFocused) then begin
    if Style = csDropDownList then begin
      Canvas.DrawFocusRect(Rect(R.Left, R.Top, R.Right - 1, R.Bottom + 1));
    end;
  end;
  if (Style <> csSimple) then PaintButton;
end;

procedure TsCustomComboBox.WndProc(var Message: TMessage);
begin
  if Assigned(FsStyle) then FsStyle.WndProc(Message);
  if Message.Result <> 1 then inherited;
end;

procedure TsCustomComboBox.Invalidate;
begin
  if (csDesigning in ComponentState) and Assigned(FsStyle) then begin
    if not RestrictDrawing then FsStyle.BGChanged := True;
  end;
  if Focused then sStyle.FFocused := True;
  Color := sStyle.GetActiveColor;
  inherited Invalidate;
end;

function TsCustomComboBox.Generate: integer;
begin
  Result := 0;
end;

procedure TsCustomComboBox.WriteText;
var
  Flags: Longint;
  R : TRect;
begin
  if Text <> '' then begin
    Flags := 0;
    Canvas.Font.Assign(Font);
    R := ClientRect;
    dec(R.Right, ButtonWidth);

    case Alignment of
      taLeftJustify : begin
        Flags := DT_LEFT;
      end;
      taRightJustify : begin
        Flags := DT_RIGHT;
      end;
      taCenter : begin
        Flags := DT_CENTER;
      end
    end;
    Flags := Flags or DT_EXPANDTABS or DT_VCENTER or DT_SINGLELINE;
    Flags := DrawTextBiDiModeFlags(Flags);

    dec(R.Left);
    dec(R.Top);

    Canvas.Pen.Style := psSolid;
    Canvas.Brush.Style := bsClear;
    if not Enabled then Canvas.Font.Color := clGray;
    DrawText(Canvas.Handle, PChar(Text), Length(Text), R, Flags);
  end;
end;

procedure TsCustomComboBox.SetAlignment(const Value: TAlignment);
begin
  if FAlignment <> Value then begin
    FAlignment := Value;
    sStyle.Invalidate;
  end;
end;  

function TsCustomComboBox.GetClientRect: TRect;
begin
  Result := Rect(0, 0, Width, Height);
  InflateRect(Result, -4, - 4);
end;

procedure TsCustomComboBox.CreateWnd;
begin
  inherited;
end;

procedure TsCustomComboBox.DropDown;
begin
  FDropDown := True;
  inherited;
end;

{ TsComboBox }

constructor TsComboBox.Create(AOwner: TComponent);
begin
  inherited;
  sStyle.COC := COC_TsComboBox;
end;


procedure TsCustomComboBox.WMNCPaint(var Message: TWMPaint);
begin
  if (csDropDown = Style) or (csDropDownList = Style) then begin
    Message.Result := 1
  end
  else inherited;
end;

procedure TsCustomComboBox.SetButtonMargin(const Value: integer);
begin
  if FButtonMargin <> Value then begin
    FButtonMargin := Value;
  end;
end;

function TsCustomComboBox.ButtonWidth: integer;
var
  i : integer;
begin
  i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, ComboBoxGlyph);
  if IsValidImgIndex(i) then begin
    Result := ma[i].Bmp.Width div 3;
  end
  else begin
    Result := bTemp.Width div 3;
  end;
end;

function TsCustomComboBox.ButtonHeight: integer;
var
  i : integer;
begin
  i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, ComboBoxGlyph);
  if IsValidImgIndex(i) then begin
    Result := ma[i].Bmp.Height div 2;
  end
  else begin
    Result := bTemp.Height div 2;
  end;
end;

procedure TsCustomComboBox.AfterConstruction;
begin
  inherited;
  sStyle.Loaded;
end;

procedure TsCustomComboBox.Loaded;
begin
  inherited;
  sStyle.Loaded;

end;

function TsCustomComboBox.IndexOf(s: string): integer;
var
  i : integer;
begin
  Result := -1;
  for i := 0 to Items.Count - 1 do begin
    if Items[i] = s then begin
      Result := i;
      Break;
    end;
  end;
end;

function TsCustomComboBox.Focused: Boolean;
var
  FocusedWnd: HWND;
begin
  Result := False;
  if HandleAllocated then begin
    FocusedWnd := GetFocus;
    Result := (FocusedWnd <> 0) and ((FocusedWnd = EditHandle) or (FocusedWnd = FListHandle));
  end;
end;

initialization
  COMBO := TBitmap.Create;
  COMBO.LoadFromResourceName(hInstance, 'COMBO');

finalization

  if Assigned(COMBO) then FreeAndNil(COMBO);

end.