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 + -
显示快捷键?