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

📄 qiplotlabel.pas

📁 iocopm3.04源码,一套很好的工控开发工具
💻 PAS
字号:
{*******************************************************}
{                                                       }
{       TiPlotLabel                                     }
{                                                       }
{       Copyright (c) 1997,2003 Iocomp Software         }
{                                                       }
{*******************************************************}
{$I iInclude.inc}

{$ifdef iVCL}unit  iPlotLabel;{$endif}
{$ifdef iCLX}unit QiPlotLabel;{$endif}

interface

uses
  {$I iIncludeUses.inc}
  {$IFDEF iVCL} Menus,  iTypes,  iGPFunctions,  iPlotObjects,  iPlotChannelCustom;{$ENDIF}
  {$IFDEF iCLX}QMenus, QiTypes, QiGPFunctions, QiPlotObjects, QiPlotChannelCustom;{$ENDIF}

type
  TiPlotLabel = class(TiPlotLayoutObject)
  private
    FRequiredWidth      : Integer;

    FMarginTopPixels    : Integer;
    FMarginBottomPixels : Integer;
    FMarginLeftPixels   : Integer;
    FMarginRightPixels  : Integer;

    FCaption            : String;
    FMarginLeft         : Double;
    FMarginRight        : Double;
    FMarginBottom       : Double;
    FMarginTop          : Double;

    FFont               : TFont;
    FAlignment          : TiAlignmentHorizontal;
  protected
    procedure SetCaption     (const Value: String);
    procedure SetMarginBottom(const Value: Double);
    procedure SetMarginLeft  (const Value: Double);                        
    procedure SetMarginRight (const Value: Double);
    procedure SetMarginTop   (const Value: Double);
    procedure SetFont        (const Value: TFont);
    procedure SetAlignment   (const Value: TiAlignmentHorizontal);

    procedure CalcRects                     (Canvas : TCanvas);

    function GetRequiredWidth(const Canvas: TCanvas): Integer;                                         override;

    procedure Draw            (const Canvas: TCanvas; const BackGroundColor: TColor);                  override;
  public
    constructor Create(AOwner: TObject; AOnChange, AOnInsert, AOnRemove, AOnRename: TNotifyEvent); override;
    destructor  Destroy;                                                                               override;

  published
    property MarginLeft   : Double                read FMarginLeft   write SetMarginLeft;
    property MarginTop    : Double                read FMarginTop    write SetMarginTop;
    property MarginRight  : Double                read FMarginRight  write SetMarginRight;
    property MarginBottom : Double                read FMarginBottom write SetMarginBottom;

    property Caption      : String                read FCaption      write SetCaption;

    property Alignment    : TiAlignmentHorizontal read FAlignment    write SetAlignment;

    property Font         : TFont                 read FFont         write SetFont;
  end;

implementation

uses
{$ifdef iVCL} iPlotManagers,  iPlotAxis,  iPlotChannel,  iXYPlotChannel;{$endif}
{$ifdef iCLX}QiPlotManagers, QiPlotAxis, QiPlotChannel, QiXYPlotChannel;{$endif}

type
  TiPlotChannelCustomAccess = class(TiPlotChannelCustom) end;
  TiPlotAxisAccess          = class(TiPlotAxis         ) end;
//****************************************************************************************************************************************************
constructor TiPlotLabel.Create(AOwner: TObject; AOnChange, AOnInsert, AOnRemove, AOnRename: TNotifyEvent);
begin
  inherited;

  Horizontal := True;

  FMarginLeft    := 0;
  FMarginRight   := 0;
  FMarginBottom  := 0;
  FMarginTop     := 0;

  FFont          := TFont.Create;
  FFont.Size     := 14;
  FFont.Style    := [fsBold];
  FFont.Color    := clWhite;
  FFont.Name     := 'Arial';
  FFont.OnChange := TriggerChange;
end;
//****************************************************************************************************************************************************
destructor TiPlotLabel.Destroy;
begin
  FFont.Free;
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiPlotLabel.SetCaption              (const Value:String );begin SetStringProperty (Value,FCaption,              TriggerChange);end;
procedure TiPlotLabel.SetMarginBottom         (const Value:Double );begin SetDoubleProperty (Value,FMarginBottom,         TriggerChange);end;
procedure TiPlotLabel.SetMarginLeft           (const Value:Double );begin SetDoubleProperty (Value,FMarginLeft,           TriggerChange);end;
procedure TiPlotLabel.SetMarginRight          (const Value:Double );begin SetDoubleProperty (Value,FMarginRight,          TriggerChange);end;
procedure TiPlotLabel.SetMarginTop            (const Value:Double );begin SetDoubleProperty (Value,FMarginTop,            TriggerChange);end;
//****************************************************************************************************************************************************
procedure TiPlotLabel.SetFont(const Value:TFont);begin FFont.Assign(Value);end;
//****************************************************************************************************************************************************
procedure TiPlotLabel.SetAlignment(const Value: TiAlignmentHorizontal);
begin
  if FAlignment <> Value then
    begin
      FAlignment := Value;
      TriggerChange(Self);
    end;
end;
//****************************************************************************************************************************************************
function TiPlotLabel.GetRequiredWidth(const Canvas: TCanvas): Integer;
begin
  CalcRects(Canvas);
  Result := FRequiredWidth;
end;
//****************************************************************************************************************************************************
procedure TiPlotLabel.CalcRects(Canvas: TCanvas);
var
  ACharWidth  : Integer;
  ACharHeight : Integer;
begin
  with Canvas, DrawRect do
    begin
      Font.Assign(FFont);

      ACharWidth   := iTextWidth (Canvas, '0');
      ACharHeight  := iTextHeight(Canvas, '0');

      FMarginTopPixels    := Round(FMarginTop   *ACharHeight);
      FMarginBottomPixels := Round(FMarginBottom*ACharHeight);
      FMarginLeftPixels   := Round(FMarginLeft  *ACharWidth);
      FMarginRightPixels  := Round(FMarginRight *ACharWidth);

      FRequiredWidth := iTextHeight(Canvas, FCaption) + FMarginTopPixels + FMarginBottomPixels;
    end;
end;
//****************************************************************************************************************************************************
procedure TiPlotLabel.Draw(const Canvas: TCanvas; const BackGroundColor: TColor);
var
  ARect      : TRect;
  ATextFlags : TiTextFlags;
  ATextWidth : Integer;
begin
  if not Visible then exit;
  CalcRects(Canvas);

  with Canvas, DrawRect do
    begin
      Font.Assign(FFont);

      ATextWidth  := iTextWidth(Canvas, Caption);

      Brush.Style := bsClear;
                                                               
      case FAlignment of
        iahCenter : ATextFlags := [itfHCenter, itfVCenter];
        iahLeft   : ATextFlags := [itfHLeft,   itfVCenter];
        iahRight  : ATextFlags := [itfHRight,  itfVCenter];
      end;

      case Horizontal of
        True : begin
                 ARect := Rect(Left + FMarginLeftPixels, Top + FMarginTopPixels, Right - FMarginRightPixels, Bottom - FMarginBottomPixels);
                 iDrawText(Canvas, Caption, ARect, ATextFlags);
                end;
        else    begin
                  ARect.Left  := Left  + FMarginTopPixels;
                  ARect.Right := Right - FMarginBottomPixels;
                  case FAlignment of
                    iahLeft   : begin
                                  ARect.Top    := Bottom - ATextWidth div 2 - FMarginLeftPixels;
                                  ARect.Bottom := Bottom - ATextWidth div 2 - FMarginLeftPixels;
                                end;
                    iahRight  : begin
                                  ARect.Top    := Top + ATextWidth div 2 + FMarginRightPixels;
                                  ARect.Bottom := Top + ATextWidth div 2 + FMarginRightPixels;
                                end;
                    else        begin
                                  ARect.Top    := (Bottom + Top) div 2 - ATextWidth div 2;
                                  ARect.Bottom := (Bottom + Top) div 2 + ATextWidth div 2;
                                end;
                  end;
                  iDrawRotatedText(Canvas, Caption, ARect, ira090);
                end;
      end;
    end;
end;
//****************************************************************************************************************************************************
end.

⌨️ 快捷键说明

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