
{************************************************}
{  This unit is a part of FreeVCL library        }
{  Copyright (c) 1998-2003 Evgeny Kryukov        }
{  See License.txt for licence information       }
{                                                }
{  http://sourceforge.net/projects/ksfreevcl     }
{                                                }
{************************************************}

// 2004.02.20 modified by usj12262

unit BaseCombo;

{$I OFFICEVER.INC}
{$P+,S-,W-,R-,H+}
{$C PRELOAD}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ComCtrls, Buttons; // ,
// OfficeTypes, // TksoBorderStyleをよぶ
// OfficeUtils; // PointInRectをよぶ

const

  SepWidth = 3; // Separator Width
  ButtonWidth: Integer = 17; // Button Width

type

  // OfficeTypes.pasより抜粋
  TksoBorderStyle = (
    kbsNone,
    kbsFlat,
    kbsSingle,
    kbsSolid,
    kbsEtched,
    kbsBump,
    kbsSunken,
    kbsRaised,
    kbsDown,
    kbsUp,
    kbsOuterRaised,
    kbsOuterSunken
    );

  TComboState = (csNormal, csFocused, csDown, csDisable);

  TksoAbstractComboBox = class(TCustomControl)
  private
    { Private declarations }
    FMouseInControl: Boolean;
    FBorderStyle: TksoBorderStyle;
    FState: TComboState;
    FComboForm: TCustomForm;
    FOnDropDown: TNotifyEvent;
    FOnChange: TNotifyEvent;
    FFlat: Boolean;
    FBorderStyleFocused: TksoBorderStyle;
    FBorderStyleFlat: TksoBorderStyle;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    { base functions }
    procedure DoDropDown(Sender: TObject);
    procedure SetBorderStyle(const Value: TksoBorderStyle);
    procedure SetBorderStyleFlat(const Value: TksoBorderStyle);
    procedure SetBorderStyleFocused(const Value: TksoBorderStyle);
    procedure SetFlat(const Value: Boolean);
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    { Abstract declarations }
    function GetDropDownForm: TCustomForm; virtual;
    procedure DrawBox(Canvas: TCanvas; R: TRect; State: TComboState); virtual;
      abstract;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure AfterDropDown; dynamic;
    { Abstract declarations }
    procedure Change; dynamic;
    procedure Previous; dynamic; abstract;
    procedure Next; dynamic; abstract;
    { Public properys }
    property State: TComboState read FState write FState;
    property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    { Published declarations }
    property Align;
    property BorderStyle: TksoBorderStyle read FBorderStyle write
      SetBorderStyle;
    property BorderStyleFlat: TksoBorderStyle read FBorderStyleFlat write
      SetBorderStyleFlat;
    property BorderStyleFocused: TksoBorderStyle read FBorderStyleFocused write
      SetBorderStyleFocused;
    property Flat: Boolean read FFlat write SetFlat;
    property Visible;
  end;

var
  DownImage: TBitmap;

implementation {===============================================================}

uses BaseComboForm;

{$R *.res}

// OfficeUtilsより抜粋

function PointInRect(P: TPoint; R: TRect): Boolean;
begin
  Result := (P.X >= R.Left) and (P.X <= R.Right) and
    (P.Y >= R.Top) and (P.Y <= R.Bottom);
end;

procedure DrawBorder(Canvas: TCanvas; Rect: TRect; Style: TksoBorderStyle);
begin
  case Style of
    kbsNone: ;
    kbsFlat:
      begin
        Canvas.Brush.Style := bsClear;
        Canvas.Pen.Style := psSolid;
        Canvas.Pen.Color := clBtnShadow;
        Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
      end;
    kbsSingle:
      begin
        Canvas.Brush.Style := bsClear;
        Canvas.Pen.Style := psSolid;
        Canvas.Pen.Color := clWindowFrame;
        Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
      end;
    kbsSolid:
      begin
        Canvas.Pen.Style := psSolid;
        Canvas.Pen.Color := clBtnFace;
        Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
        InflateRect(Rect, -1, -1);
        Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
      end;
    kbsEtched:
      begin
        DrawEdge(Canvas.Handle, Rect, EDGE_ETCHED, BF_RECT);
      end;
    kbsBump:
      begin
        DrawEdge(Canvas.Handle, Rect, BDR_RAISEDINNER, BF_RECT);
        InflateRect(Rect, -1, -1);
        DrawEdge(Canvas.Handle, Rect, BDR_SUNKENOUTER, BF_RECT);
      end;
    kbsSunken:
      begin
        DrawEdge(Canvas.Handle, Rect, EDGE_SUNKEN, BF_RECT);
      end;
    kbsRaised:
      begin
        DrawEdge(Canvas.Handle, Rect, EDGE_RAISED, BF_RECT);
      end;
    kbsDown:
      begin
        Canvas.Brush.Style := bsClear;
        Canvas.Pen.Style := psSolid;
        Canvas.Pen.Color := clWindowFrame;
        Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
        InflateRect(Rect, -1, -1);
        Canvas.Pen.Color := clBtnShadow;
        Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
      end;
    kbsUp:
      begin
        Canvas.Brush.Style := bsClear;
        Canvas.Pen.Style := psSolid;

        Canvas.Pen.Color := clWindowFrame;
        Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
        Canvas.Pen.Color := clBtnHighlight;
        Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Right - 1, Rect.Bottom - 1);
        InflateRect(Rect, -1, -1);
        Canvas.Pen.Color := clBtnFace;
        Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
        InflateRect(Rect, -1, -1);
        Canvas.Pen.Color := clBtnShadow;
        Canvas.MoveTo(Rect.Left - 1, Rect.Bottom);
        Canvas.LineTo(Rect.Right, Rect.Bottom);
        Canvas.LineTo(Rect.Right, Rect.Top - 2);
      end;
    kbsOuterRaised:
      begin
        DrawEdge(Canvas.Handle, Rect, BDR_RAISEDINNER, BF_RECT);
        InflateRect(Rect, -1, -1);
        Canvas.Pen.Style := psSolid;
        Canvas.Pen.Color := clBtnFace;
        Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
      end;
    kbsOuterSunken:
      begin
        DrawEdge(Canvas.Handle, Rect, BDR_SUNKENOUTER, BF_RECT);
        InflateRect(Rect, -1, -1);
        Canvas.Pen.Style := psSolid;
        Canvas.Pen.Color := clBtnFace;
        Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
      end;
  end;
end;

procedure DrawButton(Canvas: TCanvas; Rect: TRect;
  Flat, Focused, Down: Boolean);
begin
  with Canvas do
  begin
    if Flat then
    begin
      { Draw flat }
      if not Down then
        if not Focused then
        begin
          { Flat nofocused }
          Pen.Style := psSolid;
          Pen.Color := clBtnHighlight;
          Brush.Style := bsSolid;
          Brush.Color := clBtnFace;
          Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
          Brush.Style := bsClear;
          Rectangle(Rect.Left + 1, Rect.Top, Rect.Right, Rect.Bottom);
        end
        else
        begin
          { Flat focused }
          Pen.Style := psClear;
          Brush.Style := bsSolid;
          Brush.Color := clBtnFace;
          Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom + 1);
          Inc(Rect.Left);
          DrawEdge(Handle, Rect, BDR_RAISEDINNER, BF_RECT);
        end
      else
      begin
        { Flat down }
        Pen.Style := psClear;
        Brush.Style := bsSolid;
        Brush.Color := clBtnFace;
        Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom + 1);
        Inc(Rect.Left);
        DrawEdge(Handle, Rect, BDR_SUNKENOUTER, BF_RECT);
      end;
    end
    else
    begin
      { Normal draw }
      if not Down then
      begin
        Pen.Style := psClear;
        Brush.Style := bsSolid;
        Brush.Color := clBtnFace;
        Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
        DrawEdge(Handle, Rect, BDR_RAISEDOUTER or BDR_RAISEDINNER, BF_RECT)
      end
      else
      begin
        Pen.Style := psSolid;
        Pen.Color := clBtnShadow;
        Brush.Style := bsSolid;
        Brush.Color := clBtnFace;
        Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
      end;
    end;
  end;
end;

{ TksoAbstractComboBox }

constructor TksoAbstractComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 250;
  Height := 22;
  Color := clWindow;
  ParentColor := False;
  TabStop := True;
  ControlStyle := [csCaptureMouse, csClickEvents, csSetCaption, csOpaque,
    csDoubleClicks, csReplicatable, csReflector];

  FBorderStyle := kbsSunken;
  FFlat := False;
end;

destructor TksoAbstractComboBox.Destroy;
begin
  inherited Destroy;
end;

procedure TksoAbstractComboBox.Loaded;
begin
  inherited Loaded;
end;

procedure TksoAbstractComboBox.CMMouseEnter(var Message: TMessage);
begin
  FMouseInControl := True;
  if FState = csNormal then
    Invalidate;
end;

procedure TksoAbstractComboBox.CMMouseLeave(var Message: TMessage);
begin
  FMouseInControl := False;
  if FState = csNormal then
    Invalidate;
end;

procedure TksoAbstractComboBox.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  R: TRect;
begin
  inherited;
  if not Focused then
    SetFocus;
  R := ClientRect;
  if (PointInRect(Point(X, Y), R)) and (ssLeft in Shift) then
    DoDropDown(Self);
end;

procedure TksoAbstractComboBox.CNKeyDown(var Message: TWMKeyDown);
begin
  case Message.CharCode of
    VK_UP:
      begin
        Message.Result := 0;
      end;
    VK_DOWN:
      begin
        Message.Result := 0;
      end;
  else
    inherited;
  end;
end;

procedure TksoAbstractComboBox.WMKeyDown(var Message: TWMKeyDown);
begin
  case Message.CharCode of
    VK_UP:
      begin
        Previous;
        Message.Result := 0;
      end;
    VK_DOWN:
      begin
        Next;
        Message.Result := 0;
      end;
  else
    inherited;
  end;
end;

procedure TksoAbstractComboBox.WMKillFocus(var Message: TWMSetFocus);
begin
  inherited;
  FState := csNormal;
  Invalidate;
end;

procedure TksoAbstractComboBox.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  FState := csFocused;
  Invalidate;
end;

procedure TksoAbstractComboBox.Paint;
var
  BoxRect, R: TRect;
  Cash: TBitmap;
begin
  Cash := TBitmap.Create;
  try
    Cash.Width := Width;
    Cash.Height := Height;
    R := GetClientRect;
    // Box area
    BoxRect := R;
    InflateRect(BoxRect, -2, -2);
    Dec(BoxRect.Right, ButtonWidth);
    Cash.Canvas.Brush.Color := Color;
    { Draw background }
    Cash.Canvas.Rectangle(0, 0, Width, Height);
    { Draw border }
    if FFlat then
      if (FState = csFocused) or FMouseInControl then
        DrawBorder(Cash.Canvas, R, FBorderStyleFocused)
      else
        DrawBorder(Cash.Canvas, R, FBorderStyleFlat)
    else
      DrawBorder(Cash.Canvas, R, FBorderStyle);
    { Draw button }
    InflateRect(R, -2, -2);
    R.Left := R.Right - ButtonWidth;
    DrawButton(Cash.Canvas, R, FFlat, (FState = csFocused) or FMouseInControl,
      State = csDown);
    { Draw down image }
    if FState <> csDown then
      Cash.Canvas.Draw(R.Left + (R.Right - R.Left - DownImage.Width) div 2,
        R.Top + (R.Bottom - R.Top - DownImage.Height) div 2, DownImage)
    else
      Cash.Canvas.Draw(R.Left + (R.Right - R.Left - DownImage.Width) div 2 + 1,
        R.Top + (R.Bottom - R.Top - DownImage.Height) div 2 + 1, DownImage);
    { Draw box }
    DrawBox(Cash.Canvas, BoxRect, FState);
    Canvas.Draw(0, 0, Cash);
  finally
    Cash.Free;
  end;
end;

function TksoAbstractComboBox.GetDropDownForm: TCustomForm;
begin
  Result := nil;
end;

procedure TksoAbstractComboBox.DoDropDown(Sender: TObject);
var
  P: TPoint;
begin
  Invalidate;
  P := ClientToScreen(Point(0, Height));
  if (Assigned(FComboForm)) and ((FComboForm as TfrmCustomCombo).FreeAfterDrop)
    then
    FComboForm.Free;
  FComboForm := GetDropDownForm;
  FComboForm.Left := P.X;
  FComboForm.Top := P.Y;
  if not (FComboForm as TfrmCustomCombo).FixedWidth then
    FComboForm.Width := Width;
  (FComboForm as TfrmCustomCombo).Combo := Self;
  // DropDown Event
  if Assigned(FOnDropDown) then
    FOnDropDown(Self);
  FComboForm.Show;
  FState := csDown;
end;

procedure TksoAbstractComboBox.AfterDropDown;
begin
  if Focused then
    FState := csFocused
  else
    FState := csNormal;
  Invalidate;
  Change;
end;

procedure TksoAbstractComboBox.SetBorderStyle(const Value: TksoBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    Invalidate;
  end;
end;

procedure TksoAbstractComboBox.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TksoAbstractComboBox.SetBorderStyleFlat(const Value: TksoBorderStyle);
begin
  FBorderStyleFlat := Value;
  Invalidate;
end;

procedure TksoAbstractComboBox.SetBorderStyleFocused(const Value:
  TksoBorderStyle);
begin
  FBorderStyleFocused := Value;
  Invalidate;
end;

procedure TksoAbstractComboBox.SetFlat(const Value: Boolean);
begin
  FFlat := Value;
  if csLoading in ComponentState then Exit;
  if not FFlat then
  begin
    FBorderStyle := kbsSunken;
    FBorderStyleFlat := kbsSolid;
    FBorderStyleFocused := kbsOuterSunken;
  end
  else
  begin
    FBorderStyle := kbsSunken;
    FBorderStyleFlat := kbsSolid;
    FBorderStyleFocused := kbsOuterSunken;
  end;
  Invalidate;
end;

initialization
  DownImage := TBitmap.Create;
  DownImage.Handle := LoadBitmap(HInstance, 'KSO_DOWN');
  DownImage.Transparent := True;
  ButtonWidth := GetSystemMetrics(SM_CXHSCROLL);
finalization
  DownImage.Free;
end.
