⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 teelisb.pas

📁 TeeChart 7.0 With Source在Delphi 7.0中的安装
💻 PAS
📖 第 1 页 / 共 3 页
字号:
{***************************************}
{ TeeChart Pro - TChartListBox class    }
{ Copyright (c) 1995-2005 David Berneda }
{     Component Registration Unit       }
{***************************************}
unit TeeLisB;
{$I TeeDefs.inc}

interface

Uses {$IFNDEF LINUX}
     Windows,
     Messages,
     {$ENDIF}
     {$IFDEF CLX}
     QStdCtrls, QGraphics, QForms, QControls, QButtons, QDialogs, Qt,
     {$ELSE}
     StdCtrls, Graphics, Forms, Controls, Buttons, Dialogs,
     {$ENDIF}
     {$IFDEF D6}
     Types,
     {$ENDIF}
     SysUtils, Classes, Chart, TeeProcs, TeCanvas, TeEngine;

type
  TChartListBox=class;

  TDblClickSeriesEvent=procedure(Sender:TChartListBox; Index:Integer) of object;
  TNotifySeriesEvent=procedure(Sender:TChartListBox; Series:TCustomChartSeries) of object;
  TChangeOrderEvent=procedure(Sender:TChartListBox; Series1,Series2:TCustomChartSeries) of object;

  TListBoxSection=Packed record
    Width   : Integer;
    Visible : Boolean;
  end;

  TListBoxSections=Array[0..3] of TListBoxSection;

  TChartListBox=class(TCustomListBox,ITeeEventListener)
  private
    FAllowAdd         : Boolean;
    FAllowDelete      : Boolean;
    FAskDelete        : Boolean;
    FChart            : TCustomChart;
    FCheckStyle       : TCheckBoxesStyle;
    FEditor           : TEdit;
    FEnableChangeColor: Boolean;
    FEnableDragSeries : Boolean;
    FEnableChangeType : Boolean;
    FGroup            : TSeriesGroup;
    {$IFNDEF CLX}
    FHitTest          : TPoint;
    {$ENDIF}
    FNames            : Boolean;

    FOnChangeActive   : TNotifySeriesEvent; // 6.02
    FOnChangeColor    : TNotifySeriesEvent;
    FOnChangeOrder    : TChangeOrderEvent; // 5.03

    FOnEditSeries     : TDblClickSeriesEvent;
    FOnRemovedSeries  : TNotifySeriesEvent;
    FOtherItems       : TStrings;
    FOtherItemsChange : TNotifyEvent;
    FRefresh          : TNotifyEvent;
    ComingFromDoubleClick:Boolean;

    procedure DoRefresh;
    procedure EditorKey(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure EditorPress(Sender: TObject; var Key: Char);
    Function GetSelectedSeries:TChartSeries;
    Function GetSeriesGroup:TCustomSeriesList;
    Function GetShowActive:Boolean;
    Function GetShowIcon:Boolean;
    Function GetShowColor:Boolean;
    Function GetShowTitle:Boolean;
    function GetSeries(Index: Integer): TChartSeries;
    procedure LBSeriesClick(Sender: TObject);
    {$IFDEF CLX}
    procedure LBSeriesDrawItem(Sender: TObject; Index: Integer;
     Rect: TRect; State: TOwnerDrawState; var Handled: Boolean);
    {$ELSE}
    procedure LBSeriesDrawItem(Control: TWinControl; Index: Integer;
                                        Rect: TRect; State: TOwnerDrawState);
    {$ENDIF}
    procedure LBSeriesDragOver( Sender, Source: TObject; X,
                                 Y: Integer; State: TDragState; var Accept: Boolean);
    Procedure RefreshDesigner;
    Function SectionLeft(ASection:Integer):Integer;
    Procedure SelectSeries(AIndex:Integer);
    procedure SetChart(Value:TCustomChart);
    procedure SetCheckStyle(Value:TCheckBoxesStyle);
    procedure SetGroup(Value:TSeriesGroup);
    procedure SetNames(Value:Boolean);
    Procedure SetSelectedSeries(Value:TChartSeries);
    Procedure SetShowActive(Value:Boolean);
    Procedure SetShowIcon(Value:Boolean);
    Procedure SetShowColor(Value:Boolean);
    Procedure SetShowTitle(Value:Boolean);
  protected
    procedure DblClick; override;

    {$IFNDEF CLX}
    {$IFDEF D6}
    function GetItemIndex: Integer; override;
    {$ENDIF}
    {$ENDIF}

    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
                        X, Y: Integer); override;
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
    {$IFNDEF CLX}
    {$IFNDEF LCL}
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
    {$ELSE}
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    {$ENDIF}
    {$ENDIF}

    {$IFNDEF CLX}
    Procedure SetParent(Control:TWinControl); override;
    {$ENDIF}

    procedure TeeEvent(Event: TTeeEvent);  { interface }
  public
    ReferenceChart : TCustomChart;
    Sections : TListBoxSections;

    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    Function AddSeriesGallery:TChartSeries;
    Function AnySelected:Boolean;   { 5.01 }
    procedure ChangeTypeSeries(Sender: TObject);
    procedure ClearItems;
    {$IFNDEF D6}
    procedure ClearSelection;
    {$ENDIF}
    Procedure CloneSeries;

    Function DeleteSeries:Boolean;
    procedure DragDrop(Source: TObject; X, Y: Integer); override;
    procedure FillSeries(OldSeries:TChartSeries);
    procedure HideEditor;
    Procedure MoveCurrentDown;
    Procedure MoveCurrentUp;
    property OtherItems:TStrings read FOtherItems write FOtherItems;
    Function PointInSection(Const P:TPoint; ASection:Integer):Boolean;
    Function RenameSeries:Boolean; { 5.02 }
    Procedure SelectAll; {$IFNDEF CLX}{$IFDEF D6} override; {$ENDIF}{$ENDIF}
    property Series[Index:Integer]:TChartSeries read GetSeries;
    property SeriesGroup:TSeriesGroup read FGroup write SetGroup;
    Function SeriesAtMousePos(Var p:TPoint):Integer;
    property SelectedSeries:TChartSeries read GetSelectedSeries
                                         write SetSelectedSeries;
    Procedure ShowEditor;
    procedure SwapSeries(tmp1,tmp2:Integer);
    procedure UpdateSeries;

    property ShowSeriesNames:Boolean read FNames write SetNames;
  published
    property AllowAddSeries : Boolean read FAllowAdd
                                      write FAllowAdd default True;
    property AllowDeleteSeries : Boolean read FAllowDelete
                                         write FAllowDelete default True;
    property AskDelete:Boolean read FAskDelete write FAskDelete
                               default True;
    property Chart:TCustomChart read FChart write SetChart;

    property CheckStyle:TCheckBoxesStyle read FCheckStyle  // 6.02
                                         write SetCheckStyle default cbsCheck;

    property EnableChangeColor:Boolean read FEnableChangeColor
                                       write FEnableChangeColor default True;
    property EnableDragSeries:Boolean read FEnableDragSeries
                                      write FEnableDragSeries default True;
    property EnableChangeType:Boolean read FEnableChangeType
                                      write FEnableChangeType default True;
    property OnChangeActive:TNotifySeriesEvent read FOnChangeActive  // 6.02
                                               write FOnChangeActive;
    property OnChangeColor:TNotifySeriesEvent read FOnChangeColor
                                              write FOnChangeColor;
    property OnChangeOrder:TChangeOrderEvent read FOnChangeOrder
                                             write FOnChangeOrder;
    property OnDblClickSeries:TDblClickSeriesEvent read FOnEditSeries
                                                   write FOnEditSeries;
    property OnOtherItemsChange:TNotifyEvent read FOtherItemsChange
                                             write FOtherItemsChange;
    property OnRefresh:TNotifyEvent read FRefresh write FRefresh;
    property OnRemovedSeries:TNotifySeriesEvent read FOnRemovedSeries
                                                write FOnRemovedSeries;
    property ShowActiveCheck:Boolean read GetShowActive
                                     write SetShowActive default True;
    property ShowSeriesColor:Boolean read GetShowColor
                                     write SetShowColor default True;
    property ShowSeriesIcon:Boolean read GetShowIcon
                                    write SetShowIcon default True;
    property ShowSeriesTitle:Boolean read GetShowTitle
                                     write SetShowTitle default True;

    property Align;
    property BorderStyle;
    property Color;
    {$IFNDEF CLX}
    property Ctl3D;
    {$ENDIF}
    property Enabled;
    property ExtendedSelect;
    property Font;
    {$IFNDEF CLX}
    {$IFNDEF LCL}
    property ImeMode;
    property ImeName;
    {$ENDIF}
    {$ENDIF}
    property ItemHeight; { 5.02 }
    property MultiSelect default True;  { 5.01 }
    property ParentColor;
    {$IFNDEF CLX}
    property ParentCtl3D;
    {$ENDIF}
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted; // 7.0
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;

    {$IFDEF K3}
    property OnMouseEnter;
    property OnMouseLeave;
    {$ELSE}
    {$IFDEF D10}
    property OnMouseEnter;
    property OnMouseLeave;
    {$ENDIF}
    {$ENDIF}

    property OnMouseMove;
    property OnMouseUp;
    {$IFNDEF CLX}
    property OnStartDock;
    {$ENDIF}
    property OnStartDrag;
  end;

var TeeAddGalleryProc:Function(AOwner:TComponent; Chart:TCustomChart; Series:TChartSeries):TChartSeries=nil;
    TeeChangeGalleryProc:Function(AOwner:TComponent; var Series: TChartSeries):TChartSeriesClass=nil;

implementation

{$IFDEF CLR}
{$R 'TAreaSeries.bmp'}
{$R 'TArrowSeries.bmp'}
{$R 'TBarSeries.bmp'}
{$R 'TBubbleSeries.bmp'}
{$R 'TChartShape.bmp'}
{$R 'TFastLineSeries.bmp'}
{$R 'TGanttSeries.bmp'}
{$R 'THorizBarSeries.bmp'}
{$R 'TLineSeries.bmp'}
{$R 'TPieSeries.bmp'}
{$R 'TPointSeries.bmp'}
{$R 'THorizLineSeries.bmp'}
{$R 'THorizAreaSeries.bmp'}
{$ELSE}
{$R TeeBmps.res}
{$ENDIF}

Uses {$IFDEF CLR}
     Variants,
     {$ENDIF}
     {$IFDEF LCL}
     LCLType, // Pending to move "odSelected" to StdCtrls unit.
     {$ENDIF}
     TeePenDlg, TeeConst;

{ TChartListBox }
Constructor TChartListBox.Create(AOwner:TComponent);
begin
  inherited;
  ComingFromDoubleClick:=False;

//  DoubleBuffered:=True;

  FEnableChangeColor:=True;
  FEnableDragSeries:=True;
  FEnableChangeType:=True;

  Sections[0].Width:=26;  Sections[0].Visible:=True;
  Sections[1].Width:=16;  Sections[1].Visible:=True;
  Sections[2].Width:=26;  Sections[2].Visible:=True;
  Sections[3].Width:=216; Sections[3].Visible:=True;

  OnDrawItem:=LBSeriesDrawItem;
  OnDragOver:=LBSeriesDragOver;
  OnClick:=LBSeriesClick;

  {$IFDEF CLX}
  Style:=lbOwnerDrawVariable;
  {$ELSE}
  {$IFDEF TEEOCX} // MM lbOwnerDrawFixed breaks AX ListBox in .NET form
  Style:=lbOwnerDrawVariable;
  {$ELSE}
  Style:=lbOwnerDrawFixed;
  {$ENDIF}
  {$ENDIF}

  ItemHeight:=24;
  Sorted:=False;
  MultiSelect:=True;
  FAskDelete:=True;
  FAllowDelete:=True;
  FAllowAdd:=True;
end;

Destructor TChartListBox.Destroy;
begin
  FreeAndNil(FEditor);
  Chart:=nil;
  inherited;
end;

procedure TChartListBox.DragDrop(Source: TObject; X,Y: Integer);
var tmp1 : Integer;
    tmp2 : Integer;
begin
  if ItemIndex<>-1 then
  begin
    tmp1:=ItemIndex;
    tmp2:=ItemAtPos(TeePoint(X,Y),True);
    if (tmp2<>-1) and (tmp1<>tmp2) then SwapSeries(tmp1,tmp2);
  end;
end;

procedure TChartListBox.DoRefresh;
begin
  if Assigned(FRefresh) then FRefresh(Self);
end;

{$IFNDEF CLR}
type
  TChartAccess=class(TCustomChart);
{$ENDIF}

procedure TChartListBox.SetChart(Value:TCustomChart);
begin
  if FChart<>Value then
  begin
    if Assigned(Chart) then
    begin
      {$IFNDEF CLR}TChartAccess{$ENDIF}(Chart).RemoveListener(Self);
      {$IFDEF D5}
      Chart.RemoveFreeNotification(Self);
      {$ENDIF}
    end;

    FChart:=Value;

    if Assigned(Chart) then
    begin
      Chart.FreeNotification(Self);
      {$IFNDEF CLR}TChartAccess{$ENDIF}(Chart).Listeners.Add(Self);
      FillSeries(nil);
    end
    else ClearItems;
  end;
end;

procedure TChartListBox.SetCheckStyle(Value:TCheckBoxesStyle);
var tmpCount : Integer;
    t        : Integer;
begin
  if FCheckStyle<>Value then
  begin
    FCheckStyle:=Value;

    if FCheckStyle=cbsRadio then
    begin
      tmpCount:=0;
      // Ensure only one series is active (visible)
      for t:=0 to Items.Count-1 do
      if Series[t].Active then
      begin
        Inc(tmpCount);
        if tmpCount>1 then Series[t].Active:=False;
      end;
    end;

    Invalidate;
  end;
end;

procedure TChartListBox.ClearItems;
begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -