ilinkedlistbox.pas

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

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

{$ifdef iVCL}unit  iLinkedListBox;{$endif}
{$ifdef iCLX}unit QiLinkedListBox;{$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
  TGetItemCountEvent  = procedure(Sender: TObject;                 var Value : Integer) of object;
  TGetItemStringEvent = procedure(Sender: TObject; Index: Integer; var Value : String ) of object;
  TPaintItemEvent     = procedure(Sender: TObject; Canvas: TCanvas; ARect: TRect; State: TOwnerDrawState; Index: Integer; AText: String; var Handled: Boolean) of object;
  TPaintSetupEvent    = procedure(Sender: TObject; Canvas: TCanvas) of object;

  TiLinkedListBox = class(TiCustomComponent)
  private
    FItemIndex             : Integer;
    FFont                  : TFont;
    FColor                 : TColor;
    FTimer                 : TTimer;
    FRepeatInitialDelay    : Integer;
    FRepeatInterval        : Integer;
    FFirstTimerMessage     : Boolean;

    FStartIndex            : Integer;
    FStopIndex             : Integer;
    FLastIndex             : Integer;
    FItemCount             : Integer;
    FMaxCountVisible       : Integer;
    FBorderMargin          : Integer;
    FItemHeight            : Integer;
    FScrollBarRect         : TRect;
    FItemsRect             : TRect;
    FItemsMouseDown        : Boolean;

    FButtonUpRect          : TRect;
    FButtonDownRect        : TRect;
    FButtonUpMouseDown     : Boolean;
    FButtonDownMouseDown   : Boolean;

    FBarRect               : TRect;
    FBarButtonRect         : TRect;
    FBarButtonMouseDown    : Boolean;
    FBarButtonMouseDownTop : Integer;

    FMouseDownY            : Integer;
    FMouseMoveY            : Integer;

    FScrollBarVisible      : Boolean;

    FOnGetItemCount        : TGetItemCountEvent;
    FOnGetItemString       : TGetItemStringEvent;
    FOnPaintItem           : TPaintItemEvent;

    FSelectedColor         : TColor;
    FSelectedFontColor     : TColor;
    FShowFocusNoSelection  : Boolean;

    FOnChange              : TNotifyEvent;
    FOnPaintSetup          : TPaintSetupEvent;
  private
    function GetItemIndex: Integer;
  protected
    procedure SetItemIndex           (const Value: Integer);
    procedure SetColor               (const Value: TColor);
    procedure SetSelectedColor       (const Value: TColor);
    procedure SetSelectedFontColor   (const Value: TColor);
    procedure SetShowFocusNoSelection(const Value: Boolean);
    procedure SetFont                (const Value: TFont);

    function GetItemCount: Integer;

    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 iWantSpecialKey(var CharCode: Word; var Result: Longint);             override;
    procedure iKeyDown   (var CharCode: Word; Shift: TShiftState);                  override;

    procedure iDoSetFocus;                                                          override;
    procedure iDoKillFocus;                                                         override;

    procedure TimerEvent(Sender: TObject);

    procedure iPaintTo(Canvas: TCanvas);                                            override;

    procedure DrawScrollBar(Canvas: TCanvas);

    procedure DoButtonUpClick;
    procedure DoButtonDownClick;
    procedure DoPageUpClick;
    procedure DoPageDownClick;

    procedure ScrollSelectedInView;

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

    property  ItemCount           : Integer             read GetItemCount;
    property ItemIndex            : Integer             read GetItemIndex          write SetItemIndex;
    property ShowFocusNoSelection : Boolean             read FShowFocusNoSelection write SetShowFocusNoSelection default True;
  published
    property Font                 : TFont               read FFont                 write SetFont;
    property Color                : TColor              read FColor                write SetColor                default clWindow;
    property SelectedColor        : TColor              read FSelectedColor        write SetSelectedColor        default clNavy;
    property SelectedFontColor    : TColor              read FSelectedFontColor    write SetSelectedFontColor    default clWhite;

    property OnGetItemCount       : TGetItemCountEvent  read FOnGetItemCount       write FOnGetItemCount;
    property OnGetItemString      : TGetItemStringEvent read FOnGetItemString      write FOnGetItemString;
    property OnPaintItem          : TPaintItemEvent     read FOnPaintItem          write FOnPaintItem;
    property OnPaintSetup         : TPaintSetupEvent    read FOnPaintSetup         write FOnPaintSetup;

    property OnChange             : TNotifyEvent        read FOnChange             write FOnChange;

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

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

  Width                 := 145;
  Height                := 145;
  TabStop               := True;
  BorderStyle           := ibsLowered;
  BackGroundColor       := clWindow;

  FColor                := clWindow;
  FSelectedColor        := clNavy;
  FSelectedFontColor    := clWhite;

  FFont                 := TFont.Create;
  Font.Color            := clBlack;
  Font.OnChange         := InvalidateChangeEvent;

  FRepeatInitialDelay   := 500;
  FRepeatInterval       := 50;

  FItemIndex            := -1;

  FShowFocusNoSelection := True;

  FTimer                := TTimer.Create(Self);
  FTimer.Enabled        := False;
  FTimer.OnTimer        := TimerEvent;
end;
//****************************************************************************************************************************************************
destructor TiLinkedListBox.Destroy;
begin
  FFont.Free;
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.SetColor               (const Value:TColor );begin SetColorProperty  (Value, FColor,               irtInvalidate);end;
procedure TiLinkedListBox.SetSelectedColor       (const Value:TColor );begin SetColorProperty  (Value, FSelectedColor,       irtInvalidate);end;
procedure TiLinkedListBox.SetSelectedFontColor   (const Value:TColor );begin SetColorProperty  (Value, FSelectedFontColor,   irtInvalidate);end;
procedure TiLinkedListBox.SetShowFocusNoSelection(const Value:Boolean);begin SetBooleanProperty(Value, FShowFocusNoSelection,irtInvalidate);end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.SetFont (const Value: TFont );begin FFont.Assign(Value);end;
//****************************************************************************************************************************************************
function TiLinkedListBox.GetItemIndex: Integer;
var
  TempItemCount : Integer;
begin
  TempItemCount := ItemCount;
  if TempItemCount = -1 then FItemIndex := -1;
  if FItemIndex > (TempItemCount -1) then FItemIndex := TempItemCount-1;
  Result := FItemIndex;
end;
//****************************************************************************************************************************************************
function TiLinkedListBox.GetItemCount: Integer;
begin
  Result := 0;
  if Assigned(FonGetItemCount) then
    begin
      FOnGetItemCount(Self, FItemCount);
      if FItemCount <= 0 then
        begin
          FItemCount := 0;
          FItemIndex := -1;
        end;
      Result := FItemCount;
    end;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.SetItemIndex(const Value: Integer);
var
  OldItemIndex : Integer;
begin
  OldItemIndex := FItemIndex;
  FItemIndex := -1;

  if ItemCount <> 0 then
    begin
      if      Value < 0              then FItemIndex := 0
      else if Value > (FItemCount-1) then FItemIndex := FItemCount-1
      else                                FItemIndex := Value;
    end;

  if OldItemIndex <> FItemIndex then
    begin
      InvalidateChange;
      ScrollSelectedInView;
      if Assigned(FOnChange) then FOnChange(Self);
    end;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.iPaintTo(Canvas: TCanvas);
var
  x         : Integer;
  AText     : String;
  ARect     : TRect;
  AFlags    : TiTextFlags;
  FocusRect : TRect;
  Handled   : Boolean;
  State     : TOwnerDrawState;
begin
  with Canvas do
    begin
      Font.Assign(FFont);
      if Assigned(FOnPaintSetup) then FOnPaintSetup(Self, Canvas);

      DrawBackGround(Canvas, FColor);

      FItemHeight := iTextHeight(Canvas, 'A');

      FBorderMargin := GetBorderMargin;

      FMaxCountVisible := (Height - 2*FBorderMargin) div FItemHeight;

      GetItemCount;

      if FItemCount = 0 then Exit;

      FLastIndex := FItemCount - 1;

      FScrollBarVisible := FItemCount > FMaxCountVisible;

      if FScrollBarVisible then DrawScrollBar(Canvas);
                                DrawBorder(Canvas);

      if FMaxCountVisible >= FItemCount then FStartIndex := 0;
      if FStartIndex      >  FLastIndex then FStartIndex := FLastIndex;

      FStopIndex := FStartIndex + FMaxCountVisible;
      if FStopIndex > FLastIndex then FStopIndex := FLastIndex;

      ARect          := Rect(FBorderMargin + 2, FBorderMargin, Width - FBorderMargin, FBorderMargin + FItemHeight);

      if FScrollBarVisible then ARect.Right := FScrollBarRect.Left;

      FocusRect      := ARect;
      FocusRect.Left := FBorderMargin;