teenumericgauge.pas

BCB第三方组件

{**********************************************}
{   TeeChart Numeric Gauge style               }
{   Copyright (c) 2007 by Steema Software      }
{**********************************************}
unit TeeNumericGauge;
{$I TeeDefs.inc}

interface

uses
  {$IFNDEF LINUX}
  Windows, Messages,
  {$ENDIF}
  SysUtils, Classes, Math,
  {$IFDEF CLX}
  QGraphics, QControls, QForms, QDialogs, QStdCtrls, QExtCtrls, QComCtrls,
  QButtons,
  {$ELSE}
  Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons,
  {$ENDIF}
  {$IFDEF CLR}
  Types, Variants,
  {$ENDIF}
  TeeProcs, TeEngine, TeeEdiFont, Chart, TeCanvas, TeeEditTools, TeePenDlg,
  TeeTools;

type
  TNumericGauge=class; // forward

  TNumericMarker=class(TAnnotationTool)
  private
    FGauge : TNumericGauge;

    //INotUsePalette : Boolean;
  public
    Destructor Destroy; override;

    property Gauge:TNumericGauge read FGauge;
  end;

  TNumericMarkers=class(TChartTools)
  private
    FGauge : TNumericGauge;

    function Get(Index: Integer): TNumericMarker;
    procedure Put(Index: Integer; const Value: TNumericMarker);
    procedure SetParentChart(const Value:TCustomTeePanel);
  public
    function Add(const AText:String):TNumericMarker; overload;
    function Add(const AText:String; FontSize:Integer; APosition:TAnnotationPosition;
                 FontColor,ShapeColor:Integer):TNumericMarker; overload;
    procedure Assign(Source:TNumericMarkers); overload;

    property Items[Index:Integer]:TNumericMarker read Get write Put; default;
  end;

  TFramedBorder=class(TPersistent)
  private
    FBrush   : TChartBrush;
    FCircled : Boolean;
    FInner   : TChartBrush;
    FMiddle  : TChartBrush;
    FOuter   : TChartBrush;
    FShadow  : TTeeShadow;
    FVisible : Boolean;
    FWidth   : Integer;

    IOwner   : TChartSeries;

    procedure GetPalette;
    function IsCircledStored:Boolean;
    procedure SetCircled(const Value: Boolean);
    procedure SetInner(const Value: TChartBrush);
    procedure SetMiddle(const Value: TChartBrush);
    procedure SetOuter(const Value: TChartBrush);
    procedure SetShadow(const Value: TTeeShadow);
    procedure SetVisible(const Value: Boolean);
    procedure SetWidth(const Value: Integer);
  protected
    DefaultCircled : Boolean;

    function CalcWidth(const R:TRect):Integer;
    procedure Draw(R:TRect);
  public
    Constructor Create(AOwner:TChartSeries);
    Destructor Destroy; override;

    procedure Assign(Source:TPersistent); override;
  published
    property Circled:Boolean read FCircled write SetCircled
                             stored IsCircledStored;
    property InnerBrush:TChartBrush read FInner write SetInner;
    property MiddleBrush:TChartBrush read FMiddle write SetMiddle;
    property OuterBrush:TChartBrush read FOuter write SetOuter;
    property Shadow:TTeeShadow read FShadow write SetShadow;
    property Visible:Boolean read FVisible write SetVisible default True;
    property Width:Integer read FWidth write SetWidth default 10;
  end;

  TCustomGauge=class(TChartSeries)
  private
    FFace     : TTeeShape;
    FFrame    : TFramedBorder;
    FOnChange : TNotifyEvent;

    function GetValue: TChartValue;
    procedure SetFace(const Value: TTeeShape);
    procedure SetFrame(const Value: TFramedBorder);
  protected
    ICircled  : Boolean;
    INewRect  : TRect;
    IOrigRect : TRect;

    procedure CalcOrigRect; virtual;
    procedure DrawAllValues; override;
    procedure DrawFace; virtual;
    procedure SetGaugePalette(const Palette:Array of TColor); virtual;
    Procedure SetParentChart(Const Value:TCustomAxisPanel); override;
    procedure SetValue(const AValue: TChartValue); virtual;
    procedure SetValues; virtual;
  public
    GaugeColorPalette : TColorArray;

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

    procedure Assign(Source:TPersistent); override;
    function Clicked(x,y:Integer):Integer; override;
    function GetPaletteColor(Index:Integer):TColor;

    // To be published:
    property Face:TTeeShape read FFace write SetFace;
    property Frame:TFramedBorder read FFrame write SetFrame;
    property Value:TChartValue read GetValue write SetValue;

    // Event to be published:
    property OnChange:TNotifyEvent read FOnChange write FOnChange;
  end;

  TDigitalFont=(dfBar, dfDot, dfCustom);

  TNumericGauge=class(TCustomGauge)
  private
    FFont    : TDigitalFont;
    FMarkers : TNumericMarkers;

    procedure ChangeValueMarker;
    function GetTextMarker: TNumericMarker;
    function GetUnitsMarker: TNumericMarker;
    function GetValueMarker: TNumericMarker;
    procedure SetFont(const Value: TDigitalFont);
    procedure SetMarkers(const Value: TNumericMarkers);
  protected
    Procedure AddSampleValues(NumValues:Integer; Sequential:Boolean=False); override;
    class Procedure CreateSubGallery(AddSubChart:TChartSubGalleryProc); override;
    procedure DefineProperties(Filer: TFiler); override;
    procedure DrawAllValues; override;
    class Function GetEditorClass:String; override;
    Procedure PrepareForGallery(IsEnabled:Boolean); override;
    procedure ReadMarkers(Stream: TStream);
    procedure SetGaugePalette(const Palette:Array of TColor); override;
    Procedure SetParentChart(Const Value:TCustomAxisPanel); override;
    class Procedure SetSubGallery(ASeries:TChartSeries; Index:Integer); override;
    procedure SetValue(const Value:TChartValue); override;
    Procedure SetValueFormat(Const Value:String); override;
    procedure WriteMarkers(Stream: TStream);
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    procedure Assign(Source:TPersistent); override;
    function Clicked(x,y:Integer):Integer; override;
    Function NumSampleValues:Integer; override;
    function UseAxis:Boolean; override;

    property Markers:TNumericMarkers read FMarkers write SetMarkers;
    property TextMarker:TNumericMarker read GetTextMarker;
    property UnitsMarker:TNumericMarker read GetUnitsMarker;
    property ValueMarker:TNumericMarker read GetValueMarker;
  published
    property Active;
    property Cursor;
    property ParentChart;
    property DataSource;  { after parentchart }
    property PercentFormat;
    property ShowInLegend;
    property Title;
    property ValueFormat;

    { events }
    property AfterDrawValues;
    property BeforeDrawValues;
    property OnAfterAdd;
    property OnBeforeAdd;
    property OnChange;
    property OnClearValues;
    property OnClick;
    property OnDblClick;
    property OnMouseEnter;
    property OnMouseLeave;

    property XValues;
    property YValues;

    property DigitalFont:TDigitalFont read FFont write SetFont default dfBar;
    property Face;
    property Frame;
    property Value;
  end;

  TMarkersEditor=class(TFormTeeTools)
  protected
    function CloneTool(Tool:TTeeCustomTool):TTeeCustomTool; override;
    function GetNewTool:TTeeCustomTool; override;
  end;

  TNumericGaugeEditor = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label1: TLabel;
    EValue: TEdit;
    Label2: TLabel;
    CBPalette: TComboFlat;
    RGFont: TRadioGroup;
    TabSheet3: TTabSheet;
    PageControl2: TPageControl;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    TabSheet6: TTabSheet;
    TabFace: TTabSheet;
    TabSheet8: TTabSheet;
    Label3: TLabel;
    CBFrameVisible: TCheckBox;
    EWidth: TEdit;
    UDWidth: TUpDown;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    TabShadow: TTabSheet;
    procedure FormShow(Sender: TObject);
    procedure RGFontClick(Sender: TObject);
    procedure CBPaletteChange(Sender: TObject);
    procedure CBFrameVisibleClick(Sender: TObject);
    procedure EWidthChange(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure EValueChange(Sender: TObject);
  private
    { Private declarations }
    Tools : TMarkersEditor;
    procedure IncValue(Delta:Integer);
  protected
    Gauge : TCustomGauge;
  public
    { Public declarations }
    class procedure AddBrushDialog(ABrush:TChartBrush; AParent:TWinControl);
  end;

implementation

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

{$R TeeFonts.res}

uses
  {$IFDEF CLR}
  System.Runtime.InteropServices,
  WinUtils,
  {$ENDIF}
  TeeProCo, TeeBrushDlg, TeeCustomShapeEditor, TeeShadowEditor;

const
  TeeFontElektra='Elektra';
  TeeFontDigital='DS-Digital';

procedure TeeGaugeAddFontNames(Items:TStrings);
begin
  Items.Add(TeeFontElektra);
  Items.Add(TeeFontDigital);
end;

var
  TeeFontLCD : Integer=0;
  TeeFontLED : Integer=0;

procedure AddCustomFonts;

  {$IFDEF CLR}
  {$UNSAFECODE ON}
  {$ENDIF}

  function AddFontFromResource(const ResName:String):Integer; {$IFDEF CLR}unsafe;{$ENDIF}

    function ResourceHandle(const AName:String):THandle;
    begin
      if FindResource(MainInstance, {$IFNDEF CLR}PAnsiChar{$ENDIF}(AName),
                      RT_RCDATA) <> 0 then
         result:=MainInstance
      else
         result:=HInstance;
    end;

  var
    tmp     : TResourceStream;
    MemSize : Int64;
    Buffer  : {$IFDEF CLR}TBytes{$ELSE}Pointer{$ENDIF};

    {$IFDEF CLR}
    tmpPtr  : IntPtr;
    {$ENDIF}

    tmpC    : DWORD;
  begin
    tmp:=TResourceStream.Create(ResourceHandle(resName), resName, RT_RCDATA);
    try
      MemSize:=tmp.Size;  // Windows 2003 "+1" ??

      {$IFDEF CLR}
      SetLength(Buffer, MemSize);
      {$ELSE}
      GetMem(Buffer, MemSize);
      {$ENDIF}

      try
        {$IFDEF CLR}
        tmp.ReadBuffer(Buffer,MemSize);
        {$ELSE}
        tmp.Read(Buffer^,MemSize);
        {$ENDIF}

        tmpC:=1;

        {$IFDEF CLR}
        Marshal.StructureToPtr(TObject(Buffer),tmpPtr,False);
        result:=AddFontMemResourceEx(tmpPtr,MemSize,nil,tmpC);
        {$ELSE}
        result:=AddFontMemResourceEx(Buffer,MemSize,nil,@tmpC);
        {$ENDIF}

        //SendMessage(Application.Handle,WM_FONTCHANGE,0,0);
      finally
        {$IFDEF CLR}
        SetLength(Buffer, 0);
        {$ELSE}
        FreeMem(Buffer);
        {$ENDIF}
      end;
    finally
      tmp.Free;
    end;
  end;

  {$IFDEF CLR}
  {$UNSAFECODE OFF}
  {$ENDIF}

const
  resFile1='TEELCDFONT';
  resFile2='TEELEDFONT';
begin
  TeeFontLCD:=AddFontFromResource(resFile1);
  TeeFontLED:=AddFontFromResource(resFile2);

  // Screen.ResetFonts;  <-- EnumFonts does not recognize newly added fonts,
  // so we use here a "hook" TeeAddFontNames pseudo-event called from TeeEdiFont
  TeeAddFontNames:=TeeGaugeAddFontNames;
end;

procedure RemoveCustomFonts;
begin
  TeeAddFontNames:=nil;

  if TeeFontLCD<>0 then
     RemoveFontMemResourceEx(TeeFontLCD);

  if TeeFontLED<>0 then
     RemoveFontMemResourceEx(TeeFontLED);
end;

const
  LCDPalette : Array[0..23] of TColor=
  (
    $282828,
    $323232,
    $646464,
    $82AAAA,
    $C8DBDB,
    $82AAAA,
    $282864,
    $000000,
    $646464,
    $646464,
    $000000,
    $1EC81E,
    $3C73C8,
    $3C73C8,
    $3C73C8,
    $0A3296,
    $828282,
    $828282,
    $000000,
    $1E1E1E,
    $282828,
    $646464,
    $646464,
    $646464
    );


  LEDPalette : Array[0..23] of TColor=
  (
    $7D3705,
    $C8780A,
    $A05A05,
    $0A0A0A,
    $0A0A0A,
    $0A0A0A,
    $282864,
    $000000,
    $646464,
    $646464,
    $000000,
    $1EC81E,
    $3C73C8,
    $3C73C8,
    $3C73C8,
    $0A3296,
    $828282,
    $828282,
    $000000,
    $1E1E1E,
    $1E1EFF,
    $646464,
    $646464,