imodecombobox.pas

iocopm3.04源码,一套很好的工控开发工具

{*******************************************************}
{                                                       }
{       TiModeComboBox Component                        }
{                                                       }
{       Copyright (c) 1997,2003 Iocomp Software         }
{                                                       }
{*******************************************************}
{$I iInclude.inc}

{$ifdef iVCL}unit  iModeComboBox;{$endif}
{$ifdef iCLX}unit QiModeComboBox;{$endif}

interface

uses
  {$I iIncludeUses.inc}
  {$IFDEF iVCL} Menus,  iTypes,  iGPFunctions, iComponent,   iCustomComponent,  iComboBoxDisplay;{$ENDIF}
  {$IFDEF iCLX}QMenus, QiTypes, QiGPFunctions, QiComponent, QiCustomComponent, QiComboBoxDisplay;{$ENDIF}

type
  TiModeComboBox = class(TiCustomComponent)
  private
    FOldValue           : Integer;
    FItemList           : TStringList;
    FItemIndex          : Integer;
    FOldItemIndex       : Integer;
    FFont               : TFont;
    FDoingAutoSize      : Boolean;

    FDisplay            : TiModeComboBoxDisplay;

    FMouseDown          : Boolean;
    FAutoSize           : Boolean;
    FColor              : TColor;
    FButtonRect         : TRect;

    FOnChange           : TNotifyEvent;
    FOnChangeUser       : TNotifyEvent;
    FOnBeforeUserChange : TOnBeforeChangeInteger;
    FOnBeforeChange     : TOnBeforeChangeInteger;
    FOnAutoSize         : TNotifyEvent;
    function GetDropDownColor: TColor;
  protected
    procedure SetFont         (const Value: TFont);
    procedure iSetAutoSize    (const Value: Boolean);
    procedure SetColor        (const Value: TColor);
    procedure SetDropDownColor(const Value: TColor);
    procedure SetItemIndex    (const Value: Integer);
    procedure SetValue        (const Value: Integer);

    function GetValue     : Integer;
    function GetItemCount : Integer;

    procedure DefineProperties(Filer: TFiler); override;
    procedure WriteItems      (Writer: TWriter);
    procedure ReadItems       (Reader: TReader);
    function  DoWriteItems : Boolean;

    procedure iMouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure iMouseUp   (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure iMouseMove (                      Shift: TShiftState; X, Y: Integer); override;

    procedure iDoSetFocus;                                                          override;
    procedure iDoKillFocus;                                                         override;

    procedure iPaintTo(Canvas: TCanvas);                                            override;
    procedure DrawButton(const Canvas: TCanvas);

    procedure iKeyDown   (var CharCode: Word; Shift: TShiftState);                  override;

    {$ifdef iVCL}
    procedure WMGetDLGCode(var Message: TMessage); message WM_GETDLGCODE;
    {$endif}

    procedure FontChange(Sender : TObject);

    procedure DoChange; virtual;
    procedure DoAutoSize;

    property OnAutoSize    : TNotifyEvent  read FOnAutoSize  write FOnAutoSize;

    procedure DisplayDestroy    (Sender: TObject);
    procedure DisplaySelectIndex(Sender: TObject);

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

    {$ifdef iVCL}
    procedure OPCItemActivateSend(Index:Integer);
    {$endif}

    procedure AddItem(Caption: String; Value : Integer); reintroduce;
    procedure RemoveAllItems;

    procedure SetValueNoEvent(const Value : Integer);

    function GetItemCaption(Index: Integer): String;
    function GetItemValue  (Index: Integer): Integer;

    procedure SetItemCaption(Index: Integer; Value: String);
    procedure SetItemValue  (Index: Integer; Value: Integer);

    property ItemCount          : Integer                read GetItemCount;
  published
    property ItemIndex          : Integer                read FItemIndex          write SetItemIndex;
    property Value              : Integer                read GetValue            write SetValue;
    property AutoSize           : Boolean                read FAutoSize           write iSetAutoSize       default True;
    property Color              : TColor                 read FColor              write SetColor           default clWindow;
    property Font               : TFont                  read FFont               write SetFont;
    property DropDownColor      : TColor                 read GetDropDownColor    write SetDropDownColor   default clwindow;

    property OnChange           : TNotifyEvent           read FOnChange           write FOnChange;
    property OnChangeUser       : TNotifyEvent           read FOnChangeUser       write FOnChangeUser;
    property OnBeforeChange     : TOnBeforeChangeInteger read FOnBeforeChange     write FOnBeforeChange;
    property OnBeforeUserChange : TOnBeforeChangeInteger read FOnBeforeUserChange write FOnBeforeUserChange;

    property Width        default 145;
    property Height       default 21;
    property TabStop      default True;
    property TabOrder;

    property ErrorActive;
    property ErrorText;
    property ErrorFont;
    property ErrorBackGroundColor;
  end;

implementation
//****************************************************************************************************************************************************
constructor TiModeComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Width       := 145;
  Height      := 21;
  TabStop     := True;
  BorderStyle := ibsLowered;

  FColor         := clWindow;
  FOldValue      := -1;
  FAutoSize      := True;
  FItemIndex     := -1;

  FItemList      := TStringList.Create;
  FFont          := TFont.Create;
  FFont.Style    := [fsBold];
  Font.OnChange  := FontChange;

  FDisplay  := TiModeComboBoxDisplay.Create(Self);
  with FDisplay do
    begin
      Width        := 0;
      Height       := 0;
      OnDestroy    := DisplayDestroy;
      OnSelectItem := DisplaySelectIndex;
      Master       := Self;
      Color        := clWindow;
    end;
end;
//****************************************************************************************************************************************************
destructor TiModeComboBox.Destroy;
begin
  FItemList.Free;
  FFont.Free;
  FDisplay.Free;
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.DoChange;
var
  NewValue  : Integer;
  CanChange : Boolean;
begin
  if csLoading in ComponentState then Exit;

  NewValue := GetValue;
  CanChange := True;

  if                       Assigned(OnRequestEditProtected) then OnRequestEditProtected(Self, 'Value',             CanChange);
  if UserGenerated then if Assigned(FOnBeforeUserChange)    then FOnBeforeUserChange   (Self, FOldValue, NewValue, CanChange);
                        if Assigned(FOnBeforeChange)        then FOnBeforeChange       (Self, FOldValue, NewValue, CanChange);

  if not CanChange then
    begin
      FItemIndex := FOldItemIndex;
      InvalidateChange;
      Exit;
    end;

  {$ifdef iVCL}
  if OPCOutputData('Value', NewValue) then
    begin
      FItemIndex := FOldItemIndex;
      InvalidateChange;
      Exit;
    end;
  {$ENDIF}

  FOldValue := NewValue;

  if not(csLoading in ComponentState) then
    begin
      if                        Assigned(OnChangeProtected)  then OnChangeProtected (Self, 'Value');
      if                        Assigned(FOnChange)          then FOnChange         (Self);
      if UserGenerated then  if Assigned(FOnChangeUser)      then FOnChangeUser     (Self);
    end;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.FontChange(Sender : TObject);
begin
  DoAutoSize;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.SetColor        (const Value: TColor);begin SetColorProperty(Value, FColor,         irtInvalidate);end;
procedure TiModeComboBox.SetFont         (const Value: TFont );begin FFont.Assign(Value);                                   end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.DrawButton(const Canvas: TCanvas);
const
  Length = 2;
var
  CenterPoint : TPoint;
begin
  with Canvas, FButtonRect do
    begin
      Brush.Color := clBtnFace;
      Brush.Style := bsSolid;

      FillRect(FButtonRect);

      if FMouseDown then
        begin
          Brush.Style := bsClear;
          Pen.Color   := clBtnShadow;
          Rectangle(Left, Top, Right, Bottom);
        end
      else
        begin
          iDrawEdge(Canvas, FButtonRect, idesRaised);
        end;

      Pen.Color   := clBlack;
      Pen.Style   := psSolid;
      Brush.Color := clBlack;
      Brush.Style := bsSolid;

      CenterPoint := Point((Right + Left) div 2 - 1, (Bottom + Top) div 2);

      Canvas.Polygon([Point(CenterPoint.X - 3, CenterPoint.Y - 2),
                      Point(CenterPoint.X + 3, CenterPoint.Y - 2),
                      Point(CenterPoint.X    , CenterPoint.Y + 1)]);
    end;
end;
//****************************************************************************************************************************************************
procedure TiModeComboBox.iPaintTo(Canvas: TCanvas);
var
  AText         : String;
  ATextRect     : TRect;
  ATextFlags    : TiTextFlags;
  BorderMargin  : Integer;
  HighLightRect : TRect;
begin
  with Canvas do
    begin
      FButtonRect.Top    :=          2;
      FButtonRect.Bottom := Height - 2;
      FButtonRect.Right  := Width  - 2;
      FButtonRect.Left   := FButtonRect.Right - 16;

      if ErrorActive then
           DrawBackGround(Canvas, ErrorBackGroundColor)
      else DrawBackGround(Canvas, Self.Color);

      DrawBorder    (Canvas);
      BorderMargin := GetBorderMargin;

      ATextRect.Top        :=                     (2 + BorderMargin);
      ATextRect.Bottom     := Height -            (2 + BorderMargin);

      ATextRect.Left       :=                     (2 + BorderMargin);
      ATextRect.Right      := FButtonRect.Left  - (2);

      HighLightRect.Top    :=                     (1 + BorderMargin);
      HighLightRect.Bottom := Height -            (1 + BorderMargin);

      HighLightRect.Left   :=                     (1 + BorderMargin);
      HighLightRect.Right  := FButtonRect.Left  - (1);

      ATextFlags := [itfHLeft, itfVTop, itfSingleLine];

      if ErrorActive then
        begin
          Font.Assign(ErrorFont);
          AText := ErrorText;
          iDrawText(Canvas, AText, ATextRect, ATextFlags);
        end
      else
        begin
          Font.Assign(FFont);
          if (ItemIndex >= 0) and (ItemIndex < FItemList.Count) then AText := FItemList.Strings[ItemIndex] else AText := '';

          if HasFocus and not FDisplay.IsShowing and not FMouseDown then
            begin
              Brush.Color := clHighlight;
              Brush.Style := bsSolid;
              Font.Color  := clHighlightText;
              FillRect(HighLightRect);
              iDrawFocusRect(Canvas, HighLightRect, clHighlight);
            end;
          iDrawText(Canvas, AText, ATextRect, ATextFlags);
        end;

      DrawButton(Canvas);
  end;
end;