teelisb.pas

来自「Delphi TeeChartPro.6.01的源代码」· PAS 代码 · 共 942 行 · 第 1/2 页

PAS
942
字号
{***************************************}
{ TeeChart Pro - TChartListBox class    }
{ Copyright (c) 1995-2003 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;
       FEnableChangeColor: Boolean;
       FEnableDragSeries : Boolean;
       FEnableChangeType : Boolean;
       {$IFNDEF CLX}
       FHitTest          : TPoint;
       {$ENDIF}

       FOnChangeColor    : TNotifySeriesEvent;
       FOnChangeOrder    : TChangeOrderEvent; // 5.03

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

       procedure DoRefresh;
       Function GetSelectedSeries:TChartSeries;
       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 SetSelectedSeries(Value:TChartSeries);
       Procedure SetShowActive(Value:Boolean);
       Procedure SetShowIcon(Value:Boolean);
       Procedure SetShowColor(Value:Boolean);
       Procedure SetShowTitle(Value:Boolean);

       procedure TeeEvent(Event: TTeeEvent);  { interface }
     protected
       procedure DblClick; override;
       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}
       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}
     public
       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 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;
       Function SeriesAtMousePos(Var p:TPoint):Integer;
       property SelectedSeries:TChartSeries read GetSelectedSeries
                                            write SetSelectedSeries;
       procedure SwapSeries(tmp1,tmp2:Integer);
       procedure UpdateSeries;
     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 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 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}
       property ImeMode;
       property ImeName;
       {$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 TabOrder;
       property TabStop;
       property Visible;
       property OnClick;
       property OnEnter;
       property OnExit;
       property OnKeyDown;
       property OnKeyPress;
       property OnKeyUp;
       property OnMouseDown;
       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

{$R TeeBmps.res}

Uses 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}
  Style:=lbOwnerDrawFixed;
  {$ENDIF}
  ItemHeight:=24;
  Sorted:=False;
  MultiSelect:=True;
  FAskDelete:=True;
  FAllowDelete:=True;
  FAllowAdd:=True;
end;

Destructor TChartListBox.Destroy;
begin
  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;

type TChartAccess=class(TCustomChart);

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

    FChart:=Value;

    if Assigned(Chart) then
    begin
      Chart.FreeNotification(Self);
      TChartAccess(Chart).Listeners.Add(Self);
      FillSeries(nil);
    end
    else ClearItems;
  end;
end;

procedure TChartListBox.ClearItems;
begin
  if not (csDestroying in ComponentState) then
  begin
    Items.Clear;
    if Assigned(FOtherItems) then FOtherItems.Clear;
  end;
end;

Procedure TChartListBox.SelectSeries(AIndex:Integer); { 5.01 }
begin
  if MultiSelect then Selected[AIndex]:=True
                 else ItemIndex:=AIndex;
end;

procedure TChartListBox.SwapSeries(tmp1,tmp2:Integer);
var tmp        : TCustomForm;
    Series1    : TCustomChartSeries;
    Series2    : TCustomChartSeries;
begin
  Items.Exchange(tmp1,tmp2);
  if Assigned(FOtherItems) then FOtherItems.Exchange(tmp1,tmp2);

  if Assigned(Chart) then
  begin
    Series1:=TCustomChartSeries(Items.Objects[tmp1]);
    Series2:=TCustomChartSeries(Items.Objects[tmp2]);
    Chart.ExchangeSeries(Series1,Series2);

    if Assigned(FOnChangeOrder) then
       FOnChangeOrder(Self,Series1,Series2); // 5.03
  end;

  tmp:=GetParentForm(Self);
  if Assigned(tmp) then tmp.ActiveControl:=Self;
  SelectSeries(tmp2);
  DoRefresh;
  RefreshDesigner;
end;

procedure TChartListBox.LBSeriesClick(Sender: TObject);
begin
  DoRefresh;
end;

Function TChartListBox.SectionLeft(ASection:Integer):Integer;
var t : Integer;
begin
  result:=0;
  for t:=0 to ASection-1 do
  if Sections[t].Visible then Inc(result,Sections[t].Width);
end;

type TSeriesAccess=class(TChartSeries);

{$IFDEF CLX}
procedure TChartListBox.LBSeriesDrawItem(Sender: TObject; Index: Integer;
     Rect: TRect; State: TOwnerDrawState; var Handled: Boolean);
{$ELSE}
procedure TChartListBox.LBSeriesDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
{$ENDIF}
Const BrushColors : Array[Boolean] of TColor=(clWindow,clHighLight);
      FontColors  : Array[Boolean] of TColor=(clWindowText,clHighlightText);
var tmp       : Integer;
    tmpSeries : TChartSeries;
    tmpR      : TRect;
    CBRect    : TRect;
    tmpCanvas : TCanvas;
    tmpBitmap : TBitmap;
begin
  tmpCanvas:=Canvas;
  With tmpCanvas do
  begin
    if odSelected in State then Brush.Color:=clHighLight
                           else Brush.Color:=Self.Color;
    {$IFDEF CLX}
    Brush.Style:=bsSolid;
    {$ENDIF}
    FillRect(Rect);

    Brush.Color:=Self.Color;
    Brush.Style:=bsSolid;
    tmpR:=Rect;
    tmpR.Right:=SectionLeft(3)-2;

    {$IFDEF CLX}
    Inc(tmpR.Bottom);
    {$ENDIF}

    FillRect(tmpR);

    tmpSeries:=Series[Index];

    if Assigned(tmpSeries) then
    begin

      if ShowSeriesIcon then
      begin
        tmpBitmap:=TBitmap.Create;
        try
          TeeGetBitmapEditor(tmpSeries,tmpBitmap);
          {$IFNDEF CLX}
          tmpBitmap.Transparent:=True;
          {$ENDIF}
          Draw(SectionLeft(0),Rect.Top,tmpBitmap);
        finally
          tmpBitmap.Free;
        end;
      end;

      if ShowSeriesColor and
         (TSeriesAccess(tmpSeries).IUseSeriesColor) then
      begin
        tmp:=SectionLeft(2)-2;
        tmpR:=Classes.Rect(tmp,Rect.Top,tmp+Sections[2].Width,Rect.Bottom);
        InflateRect(tmpR,-4,-4);
        PaintSeriesLegend(tmpSeries,tmpCanvas,tmpR);
      end;

      if ShowActiveCheck then
      begin
        tmp:=SectionLeft(1);
        CBRect:=Classes.Rect(tmp+2,Rect.Top+6,tmp+12,Rect.Top+18);
        TeeDrawCheckBox(CBRect.Left,CBRect.Top,tmpCanvas,tmpSeries.Active,Self.Color);
      end;

      Brush.Style:=bsClear;
      if ShowSeriesTitle then
      begin
        if odSelected in State then Font.Color:={$IFNDEF CLX}ColorToRGB{$ENDIF}(clHighlightText)
                               else Font.Color:=ColorToRGB(Self.Font.Color);

        {$IFDEF CLX}
        Start;
        QPainter_setBackgroundMode(Handle,BGMode_TransparentMode);
        Stop;
        {$ELSE}
        SetBkMode(Handle,Transparent);
        {$ENDIF}

        TextOut(SectionLeft(3)+1,Rect.Top+((ItemHeight-TextHeight('W')) div 2),Items[Index]);

        {$IFDEF CLX}
        Start;
        QPainter_setBackgroundMode(Handle,BGMode_OpaqueMode);
        Stop;
        {$ELSE}
        SetBkMode(Handle,Opaque);
        {$ENDIF}
      end
      else TextOut(0,0,'');
      
    end;
  end;
end;

Function TChartListBox.GetSelectedSeries:TChartSeries;
begin
  result:=Series[ItemIndex];
end;

Procedure TChartListBox.SetSelectedSeries(Value:TChartSeries);
begin
  ItemIndex:=Items.IndexOfObject(Value);
  if ItemIndex<>-1 then Selected[ItemIndex]:=True;
  {$IFDEF CLX}
  DoRefresh;
  {$ENDIF}
end;

procedure TChartListBox.LBSeriesDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept:=FEnableDragSeries and (Sender=Source);

⌨️ 快捷键说明

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