rm_anglbl.pas

中小企业管理系统------ ERP系统原代码

{*****************************************}
{                                         }
{             Report Machine v2.0         }
{         Checkbox Add-In Object          }
{                                         }
{*****************************************}

unit RM_AngLbl;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Menus, RM_Class
{$IFDEF Delphi6}, Variants{$ENDIF};

type
  TRMAngledLabelObject = class(TComponent) // fake component
  end;

  TRMAnchorStyle = (asNone, asTextLeft, asTextCenter, asTextRight);
  TRMAngledValues = record
    fntWidth, fntHeight, txtWidth, txtHeight, gapTxtWidth, gapTxtHeight: Integer;
    totWidth, totHeight, posLeft, posTop, posX, posY: Integer
  end;

  { TRMAngledLabelView }
  TRMAngledLabelView = class(TRMMemoView)
  private
		FMyVersion: Byte;

    procedure CalculateAngledValues(var aValues: TRMAngledValues; const aStr: string);
    procedure DrawAngledLabel(const aStr: string);
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    AnchorStyle: TRMAnchorStyle;
    Angle: Integer;
    constructor Create; override;
    procedure Draw(aCanvas: TCanvas); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefinePopupMenu(Popup: TPopupMenu); override;
    procedure DefineProperties; override;
  end;

implementation

uses RM_CmpReg, RM_Intrp, RM_Pars, RM_Utils, RM_Const;

function DegToRad(aDegrees: Real): Real;
begin
  Result := (aDegrees * PI / 180);
end;

procedure CreateAngledFont(aCanvas: TCanvas; aAngle: Integer);
var
  F: TLogFont;
begin
  GetObject(aCanvas.Font.Handle, SizeOf(TLogFont), @F);
  F.lfEscapement := aAngle * 10;
  F.lfOrientation := aAngle * 10{OUT_TT_ONLY_PRECIS};
  aCanvas.Font.Handle := CreateFontIndirect(F);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMAngledLabelView}

constructor TRMAngledLabelView.Create;
begin
  inherited Create;
  BaseName := 'AngledLabel';
  PStretched := False;
  PWordWrap := False;
  Angle := 45;
  AnchorStyle := asNone;

  RMConsts['asNone'] := asNone;
  RMConsts['asTextLeft'] := asTextLeft;
  RMConsts['asTextCenter'] := asTextCenter;
  RMConsts['asTextRight'] := asTextRight;
end;

procedure TRMAngledLabelView.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Angle', [rmdtInteger], nil);
  AddEnumProperty('AnchorStyle', 'asNone;asTextLeft;asTextCenter;asTextRight',
    [asNone, asTextLeft, asTextCenter, asTextRight], nil);

  RemoveProperty('Stretched');
  RemoveProperty('Wordwrap');
  RemoveProperty('AutoWidth');
end;

procedure TRMAngledLabelView.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'ANGLE' then
    Angle := Value
  else if Index = 'ANCHORSTYLE' then
    AnchorStyle := Value
end;

function TRMAngledLabelView.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'ANGLE' then
    Result := Angle
  else if Index = 'ANCHORSTYLE' then
    Result := AnchorStyle
end;

procedure TRMAngledLabelView.CalculateAngledValues(var aValues: TRMAngledValues; const aStr: string);
var
  angB: Real;
  nCenterX, nCenterY: Integer;
begin
  CreateAngledFont(Canvas, Angle);
  aValues.fntWidth := Canvas.TextWidth(aStr);
  aValues.fntHeight := Canvas.TextHeight(aStr);
  case Angle of
    0..89: angB := DegToRad(90 - Angle);
    90..179: angB := DegToRad(Angle - 90);
    180..269: angB := DegToRad(270 - Angle);
  else { 270..359 }
    angB := DegToRad(Angle - 270)
  end;
  aValues.txtWidth := Round(sin(angB) * aValues.fntWidth);
  aValues.gapTxtWidth := Round(cos(angB) * aValues.fntHeight);
  aValues.txtHeight := Round(cos(angB) * aValues.fntWidth);
  aValues.gapTxtHeight := Round(sin(angB) * aValues.fntHeight);

  aValues.totWidth := (aValues.txtWidth + aValues.gapTxtWidth);
  aValues.totHeight := (aValues.txtHeight + aValues.gapTxtHeight);

  if AnchorStyle in [asNone] then
  begin
    aValues.posLeft := x;
    aValues.posTop := y;
  end
  else if AnchorStyle in [asTextLeft] then
  begin
    case Angle of 0..89, 270..359:
        aValues.posLeft := x
    else { 90..179, 180..269 }
      aValues.posLeft := (x + dx - aValues.totWidth)
    end;
    case Angle of 180..269, 270..359:
        aValues.posTop := y
    else { 0..89, 90..179 }
      aValues.posTop := (y + dy - aValues.totHeight)
    end;
  end
  else if AnchorStyle in [asTextRight] then
  begin
    case Angle of 90..179, 180..269:
        aValues.posLeft := x
    else { 0..89, 270..359 }
      aValues.posLeft := (x + dx - aValues.totWidth)
    end;
    case Angle of 0..89, 90..179:
        aValues.posTop := y
    else { 180..269, 270..359 }
      aValues.posTop := (y + dy - aValues.totHeight)
    end;
  end
  else { asTextCenter }
  begin
    aValues.posLeft := (x + Round((dx - aValues.totWidth) / 2));
    aValues.posTop := (y + Round((dy - aValues.totHeight) / 2));
  end;

  case Angle of
    0..89:
      begin
        aValues.posX := 0;
        aValues.posY := aValues.txtHeight
      end;
    90..179:
      begin
        aValues.posX := aValues.txtWidth;
        aValues.posY := aValues.totHeight
      end;
    180..269:
      begin
        aValues.posX := aValues.totWidth;
        aValues.posY := aValues.gapTxtHeight
      end;
  else { 270..359 }
    aValues.posX := aValues.gapTxtWidth;
    aValues.posY := 0
  end;

  if (AnchorStyle in [asTextLeft, asTextRight, asTextCenter]) then
  begin
    if AnchorStyle in [asTextLeft] then
    begin
      case Angle of
        0..89:
          begin
            aValues.posX := 0;
            aValues.posY := (dy - aValues.gapTxtHeight);
          end;
        90..179:
          begin
            aValues.posX := (dx - aValues.gapTxtWidth);
            aValues.posY := dy;
          end;
        180..279:
          begin
            aValues.posX := dx;
            aValues.posY := aValues.gapTxtHeight;
          end;
      else { 280..359 }
        aValues.posX := aValues.gapTxtWidth;
        aValues.posY := 0;
      end;
    end
    else if AnchorStyle in [asTextRight] then
    begin
      case Angle of
        0..89:
          begin
            aValues.posX := (dx - aValues.txtWidth - aValues.gapTxtWidth);
            aValues.posY := aValues.txtHeight;
          end;
        90..179:
          begin
            aValues.posX := aValues.txtWidth;
            aValues.posY := (aValues.txtHeight + aValues.gapTxtHeight);
          end;
        180..279:
          begin
            aValues.posX := (aValues.txtWidth + aValues.gapTxtWidth);
            aValues.posY := (dy - aValues.txtHeight);
          end;
      else { 280..359 }
        aValues.posX := (dx - aValues.txtWidth);
        aValues.posY := (dy - aValues.txtHeight - aValues.gapTxtHeight);
      end;
    end
    else { asTextCenter }
    begin
      nCenterX := Round((dx - aValues.txtWidth - aValues.gapTxtHeight) / 2);
      nCenterY := Round((dy - aValues.txtHeight - aValues.gapTxtHeight) / 2);
      case Angle of
        0..89:
          begin
            aValues.posX := nCenterX;
            aValues.posY := (nCenterY + aValues.txtHeight);
          end;
        90..179:
          begin
            aValues.posX := (nCenterX + aValues.txtWidth);
            aValues.posY := (nCenterY + aValues.txtHeight + aValues.gapTxtHeight);
          end;
        180..279:
          begin
            aValues.posX := (nCenterX + aValues.txtWidth + aValues.gapTxtWidth);
            aValues.posY := (nCenterY + aValues.gapTxtHeight);
          end;
      else // 280..359
        aValues.posX := (nCenterX + aValues.gapTxtWidth);
        aValues.posY := nCenterY;
      end;
    end;
  end;
  aValues.posX := aValues.posX + x;
  aValues.posY := aValues.posY + y;
end;

procedure TRMAngledLabelView.DrawAngledLabel(const aStr: string);
var
	liValues: TRMAngledValues;
begin
  AssignFont(Canvas);
  SetTextCharacterExtra(Canvas.Handle, Round(CharacterSpacing * ScaleX));
  CalculateAngledValues(liValues, aStr);
  ExtTextOut(Canvas.Handle, liValues.posX, liValues.posY, ETO_CLIPPED, @DRect,
    PChar(aStr), Length(aStr), nil);
end;

procedure TRMAngledLabelView.Draw(aCanvas: TCanvas);
begin
  BeginDraw(aCanvas);
  Memo1.Assign(Memo);
  CalcGaps;
  ShowBackground;
  ShowFrame;
  if Memo1.Count > 0 then
    DrawAngledLabel(Memo1[0]);

  SetTextCharacterExtra(aCanvas.Handle, 0);
  RestoreCoord;
end;

procedure TRMAngledLabelView.DefinePopupMenu(Popup: TPopupMenu);
begin
end;

procedure TRMAngledLabelView.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  if LVersion >= 11 then
  	FMyVersion := RMReadByte(Stream)
  else
  	FMyVersion := 0;

  Angle := RMReadInteger(Stream);
  AnchorStyle := TRMAnchorStyle(RMReadByte(Stream));
end;

procedure TRMAngledLabelView.SaveToStream(Stream: TStream);
begin
	FMyVersion := 1;
  inherited SaveToStream(Stream);
	RMWriteByte(Stream, FMyVersion);
  RMWriteInteger(Stream, Angle);
  RMWriteByte(Stream, Byte(AnchorStyle));
end;

initialization
  RMRegisterObjectByRes(TRMAngledLabelView, 'RM_ANGLEDLABLE', RMLoadStr(SInsAngledLabel), nil);

end.



//此源码由程序太平洋收集整理发布,任何人都可自由转载,但需保留本站信息
//╭⌒╮┅~ ¤　欢迎光临程序太平洋╭⌒╮
//╭⌒╭⌒╮╭⌒╮～╭⌒╮  ︶  ,︶︶
//,︶︶︶︶,''︶~~ ,''~︶︶　 ,''
//╔　╱◥███◣═╬╬╬╬╬╬╬╬╬╗
//╬ ︱田︱田 田 ︱　　　　　　　　　 ╬
//╬　　　　　　　http://www.5ivb.net ╬
//╬　 ╭○╮●　                   　╬
//╬　　/■\/■\　　                  ╬
//╬　　 <|　||　   有希望,就有成功！ ╬
//╬　　　　　　　　　　　　　　　　　╬
//╚╬╬╬╬╬╬╬╬╬╬╗  ╔╬╬╬╬╝
//
//说明：
//专业提供VB、．NET、Delphi、ASP、PB源码下载
//包括:程序源码,控件,商业源码,系统方案，开发工具，书籍教程，技术文档