teeseriestexted.pas

BCB第三方组件

{******************************************}
{ TSeriesTextSource Editor                 }
{ Copyright (c) 2000-2007 by David Berneda }
{    All Rights Reserved                   }
{******************************************}
unit TeeSeriesTextEd;
{$I TeeDefs.inc}

interface

uses {$IFNDEF LINUX}
     Windows, Messages,
     {$ENDIF}
     SysUtils, Classes,
     {$IFDEF CLX}
     QGraphics, QControls, QForms, QDialogs, QStdCtrls, QExtCtrls, QComCtrls,
     QGrids, QButtons,
     {$ELSE}
     Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls,
     Grids, Buttons,
     {$ENDIF}
     TeeURL, TeeProcs, TeEngine, TeCanvas, TeeSourceEdit
     {$IFDEF AXUNICODE}
     ,Unicode, TeeUnicode
     {$ENDIF}
     ;

Const
  TeeDefaultFieldSeparator=',';

type
  TSeriesTextField=class;

  TSeriesTextGetValue=procedure(Field:TSeriesTextField;
                                Const Text:String; Var Value:Double) of object;

  TSeriesTextField=class(TCollectionItem)
  private
    FFieldIndex : Integer;
    FFieldName  : String;
    FOnGetValue : TSeriesTextGetValue;
    procedure SetFieldIndex(const Value: Integer);
  protected
    { Protected declarations }
    Data : TObject;
  published
    property FieldIndex:Integer read FFieldIndex write SetFieldIndex;
    property FieldName:String read FFieldName write FFieldName;
    property OnGetValue:TSeriesTextGetValue read FOnGetValue write FOnGetValue;
  end;

  TSeriesTextFields=class(TOwnedCollection)
  private
    Function Get(Index:Integer):TSeriesTextField;
    Procedure Put(Index:Integer; Const Value:TSeriesTextField);
  public
    property Items[Index:Integer]:TSeriesTextField read Get write Put; default;
  end;

  TSeriesTextSource=class(TTeeSeriesSourceFile)
  private
    FFields     : TSeriesTextFields;
    FHeader     : Integer;
    FSeparator  : String;
    FText       : TStrings;

    procedure SetFields(const Value: TSeriesTextFields);
    procedure SetText(const Value: TStrings);
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    Function AddField(Const AName:String; AIndex:Integer):TSeriesTextField;

    class Function Description:String; override;
    class Function Editor:TComponentClass; override;

    procedure LoadFromStream(AStream: TStream); override;
    Procedure LoadFromStrings(AStrings:TStrings);
    {$IFDEF AXUNICODE}
    Procedure LoadFromWideStrings(AStrings:TWideStringList);
    {$ENDIF}
  published
    property Active;
    property HeaderLines:Integer read FHeader write FHeader default 0;
    property Fields:TSeriesTextFields read FFields write SetFields;
    property FieldSeparator:String read FSeparator write FSeparator;
    property FileName;
    property Series;
    property Text:TStrings read FText write SetText;
  end;

  TSeriesTextEditor = class(TBaseSourceEditor)
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    Button2: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    UpDown1: TUpDown;
    StringGrid1: TStringGrid;
    CBSeries: TComboFlat;
    CBSep: TComboFlat;
    TabSheet2: TTabSheet;
    BBrowse: TSpeedButton;
    RBFile: TRadioButton;
    EFile: TEdit;
    RBWeb: TRadioButton;
    EWeb: TEdit;
    ButtonLoad: TButton;
    PanBot: TPanel;
    TabSheet3: TTabSheet;
    MemoText: TMemo;
    RBManual: TRadioButton;
    procedure FormShow(Sender: TObject);
    procedure CBSeriesChange(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ButtonLoadClick(Sender: TObject);
    procedure RBFileClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BApplyClick(Sender: TObject);
    procedure EFileChange(Sender: TObject);
    procedure EWebChange(Sender: TObject);
    procedure CBSepChange(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure FormDestroy(Sender: TObject);
    procedure MemoTextChange(Sender: TObject);
    procedure RBManualClick(Sender: TObject);
  private
    { Private declarations }
    InternalSource : Boolean;
    procedure HideSeriesCombo;
    Function SelectedSeries:TChartSeries;
    Procedure SetOptions;
  public
    { Public declarations }
    DataSource : TSeriesTextSource;
  end;

Procedure TeeEditSeriesTextSource(ASource:TSeriesTextSource);

implementation

{$IFNDEF CLX}
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
{$ELSE}
{$R *.xfm}
{$ENDIF}

Uses
  {$IFDEF CLR}
  Variants,
  {$ENDIF}
  TeeConst, TeePenDlg, TeeProCo;

{ create a Form to edit the Series Text source }
Procedure TeeEditSeriesTextSource(ASource:TSeriesTextSource);
var tmp : TSeriesTextEditor;
begin
  tmp:=TSeriesTextEditor(TeeCreateForm(TSeriesTextEditor,nil));
  with tmp do
  try
    TeeTranslateControl(tmp);
    Tag:={$IFDEF CLR}Variant{$ELSE}Integer{$ENDIF}(ASource);
    ShowModal;
  finally
    Free;
  end
end;

procedure TSeriesTextEditor.HideSeriesCombo;
begin
  { hide series combobox }
  CBSeries.Visible:=False;
  Label3.Visible:=False;
  PageControl1.Align:=alClient;
end;

procedure TSeriesTextEditor.FormShow(Sender: TObject);
var tmp : TChartSeries;
    t   : Integer;
begin
  inherited;
  InternalSource:=False;
  StringGrid1.ColWidths[1]:=50; { 5.02 }

  { find Text Source object }
  if TObject(Tag) is TSeriesTextSource then
  begin
    DataSource:=TSeriesTextSource(Tag);
    TheSeries:=DataSource.Series;
    Pan.Visible:=False;
  end
  else
  if TObject(Tag) is TChartSeries then
  begin
    if TheSeries.DataSource is TSeriesTextSource then
    begin
      DataSource:=TSeriesTextSource(TheSeries.DataSource);
      HideSeriesCombo;
    end;
  end;

  if not Assigned(DataSource) then
  begin
    if TObject(Tag) is TChartSeries then
    begin
      if Assigned(TheSeries.Owner) then
      begin
        DataSource:=TSeriesTextSource.Create(TheSeries.Owner);
        InternalSource:=True;
        DataSource.Name:=TeeGetUniqueName(DataSource.Owner,'SeriesTextSource'); { <-- do not translate }
      end
      else DataSource:=TSeriesTextSource.Create(TheSeries);


      HideSeriesCombo;
      PageControl1.ActivePage:=TabSheet2;
    end;
  end;

  if Assigned(DataSource) then
  begin
    { set form controls }
    with DataSource do
    begin
      UpDown1.Position:=HeaderLines;

      if FieldSeparator=',' then CBSep.ItemIndex:=0
      else
      if FieldSeparator=' ' then CBSep.ItemIndex:=1
      else
      if FieldSeparator=#9 then CBSep.ItemIndex:=2
      else
      begin
        CBSep.ItemIndex:=-1;
        CBSep.Text:=FieldSeparator;
      end;

      if Assigned(Owner) then
      begin
        if CBSeries.Visible then
        begin
          With Owner do
          for t:=0 to ComponentCount-1 do
          if Components[t] is TChartSeries then
          begin
            tmp:=TChartSeries(Components[t]);
            CBSeries.Items.AddObject(SeriesTitleOrName(tmp),tmp);
          end;
        end
        else
           CBSeries.Items.AddObject(SeriesTitleOrName(TheSeries),TheSeries);

        with CBSeries do
        if Visible then
           ItemIndex:=Items.IndexOfObject(Series)
        else
           ItemIndex:=Items.IndexOfObject(TheSeries);

        if CBSeries.ItemIndex<>-1 then CBSeriesChange(Self)
        else
        begin
          StringGrid1.Enabled:=False;
          ButtonLoad.Enabled:=False;
        end;
      end;

      { set text filename }
      if FileName='' then
         RBManual.Checked:=True
      else
        if Copy(Uppercase(FileName),1,7)='HTTP://' then
        begin
          EWeb.Text:=FileName;
          RBWeb.Checked:=True;
          RBFileClick(RBWeb);
        end
        else
        begin
          EFile.Text:=FileName;
          RBFile.Checked:=True;
          RBFileClick(RBFile);
        end;

      MemoText.Lines:=Text;
    end;

    BApply.Enabled:=Assigned(TheSeries) and (TheSeries.DataSource<>DataSource);
  end;

  PanBot.Visible:=not Assigned(Parent);
end;

procedure TSeriesTextEditor.CBSeriesChange(Sender: TObject);

  { return the "field index" corresponding to AName value list }
  Function GetFieldIndexSt(Const AName:String):String;
  var t : Integer;
  begin
    result:='';

    With DataSource do
    for t:=0 to Fields.Count-1 do
    if Uppercase(Fields[t].FieldName)=Uppercase(AName) then
    begin
      Str(Fields[t].FieldIndex,result);
      Exit;
    end;
  end;

var t   : Integer;
    tmp : TChartSeries;
begin
  if CBSeries.ItemIndex<>-1 then
  begin
    StringGrid1.Enabled:=True;
    ButtonLoad.Enabled:=True;
    tmp:=SelectedSeries;

    if Assigned(tmp) then
    begin
      StringGrid1.RowCount:=2+tmp.ValuesList.Count;
      StringGrid1.Cells[1,0]:=TeeMsg_Column;
      StringGrid1.Cells[0,1]:=TeeMsg_Text;
      StringGrid1.Cells[1,1]:=GetFieldIndexSt(TeeMsg_Text);

      With tmp do
      for t:=0 to ValuesList.Count-1 do
      begin
        StringGrid1.Cells[0,2+t]:=ValuesList[t].Name;
        StringGrid1.Cells[1,2+t]:=GetFieldIndexSt(ValuesList[t].Name);
      end;
    end;
  end;
end;

Procedure TSeriesTextEditor.SetOptions;
var t: Integer;
begin
  With DataSource do
  begin
    if RBManual.Checked then
    begin
      FileName:='';
      Text:=MemoText.Lines;
    end
    else
    if RBWeb.Checked then FileName:=EWeb.Text
                     else FileName:=EFile.Text;

    HeaderLines:=UpDown1.Position;

    Case CBSep.ItemIndex of
      0: FieldSeparator:=',';
      1: FieldSeparator:=' ';
      2: FieldSeparator:=#9;
    else
         FieldSeparator:=CBSep.Text;
    end;

    Fields.Clear;

    if CBSeries.ItemIndex<>-1 then
    begin
      Series:=SelectedSeries;

      for t:=1 to StringGrid1.RowCount-1 do
      begin
        if StringGrid1.Cells[1,t]<>'' then
           AddField(StringGrid1.Cells[0,t],StrToInt(StringGrid1.Cells[1,t]));
      end;
    end;
  end;
end;

Function TSeriesTextEditor.SelectedSeries:TChartSeries;
begin
  result:=TChartSeries(CBSeries.SelectedObject);
end;

procedure TSeriesTextEditor.Button1Click(Sender: TObject);
begin
  SetOptions;
end;

procedure TSeriesTextEditor.ButtonLoadClick(Sender: TObject);
begin
  Screen.Cursor:=crHourGlass;
  try
    SetOptions;