开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
MMEnvelp.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：45k
源码类别：

Delphi控件源码

开发平台：

Delphi

MMEnvelp.pas：源码内容
  1. {========================================================================}
  2. {=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
  3. {========================================================================}
  4. {=                          All Rights Reserved                         =}
  5. {========================================================================}
  6. {=  D 01099 Dresden             = Fax.: +49 (0)351-8037944              =}
  7. {=  Loewenstr.7a                = info@swiftsoft.de                     =}
  8. {========================================================================}
  9. {=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
  10. {========================================================================}
  11. {=  This code is for reference purposes only and may not be copied or   =}
  12. {=  distributed in any format electronic or otherwise except one copy   =}
  13. {=  for backup purposes.                                                =}
  14. {=                                                                      =}
  15. {=  No Delphi Component Kit or Component individually or in a collection=}
  16. {=  subclassed or otherwise from the code in this unit, or associated   =}
  17. {=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
  18. {=  without express permission from SwiftSoft.                          =}
  19. {=                                                                      =}
  20. {=  For more licence informations please refer to the associated        =}
  21. {=  HelpFile.                                                           =}
  22. {========================================================================}
  23. {=  $Date: 11.08.98 - 01:23:42 $                                        =}
  24. {========================================================================}
  25. unit MMEnvelp;
  27. {$I COMPILER.INC}
  29. interface
  31. uses
  32. {$IFDEF WIN32}
  33.   Windows,
  34. {$ELSE}
  35.   WinProcs,
  36.   WinTypes,
  37. {$ENDIF}
  38.   SysUtils,
  39.   Messages,
  40.   Classes,
  41.   Graphics,
  42.   Controls,
  43.   Forms,
  44.   Dialogs,
  45.   MMObj,
  46.   MMDIBCv,
  47.   MMPanel,
  48.   MMUtils,
  49.   MMString,
  50.   MMMulDiv,
  51.   MMMath,
  52.   MMObjLst,
  53.   MMPCMSup,
  54.   MMObsrv;
  56. type
  57.   TMMEnvelopeKind = (ekRectangle, ekCircle, ekOwnerDraw);
  58.   TMMEnvelopeDrawPoint = procedure(Sender: TObject; Canvas: TCanvas;
  59.                                    Rect: TRect; Selected: Boolean) of object;
  61.   TMMEnvelope = class;
  63.   {-- TMMEnvelopePoint --------------------------------------------------}
  64.   TMMEnvelopePoint = class(TObject)
  65.   private
  66.      procedure   Store(S: TStream); virtual;
  67.      procedure   Load(S: TStream); virtual;
  69.   public
  70.      X_Value : Longint;
  71.      Y_Value : Longint;
  72.      Selected: Boolean;
  74.      constructor Create;
  75.      constructor CreateEx(X,Y: integer; Sel: Boolean);
  77.      procedure   SetParams(X,Y: integer; Sel: Boolean);
  78.      procedure   Assign(Source: TObject);
  79.   end;
  81.   {-- TMMEnvelopePointList ----------------------------------------------}
  82.   TMMEnvelopePointList = class(TObjectList)
  83.   private
  84.     FEnvelope: TMMEnvelope;
  86.     procedure PutPoint(Index: integer; Point: TMMEnvelopePoint);
  87.     function  GetPoint(Index: integer): TMMEnvelopePoint;
  89.   protected
  90.     procedure ReadData(S: TStream); override;
  91.     procedure WriteData(S: TStream); override;
  93.   public
  94.     procedure Assign(Source: TPersistent); override;
  95.     property  Items[Index: integer]: TMMEnvelopePoint read GetPoint write PutPoint; default;
  96.   end;
  98.   {-- TMMEnvelope -------------------------------------------------------}
  99.   TMMEnvelope = class(TMMMarkerPanel)
  100.   private
  101.     FDIBCanvas      : TMMDIBCanvas;
  102.     FPoints         : TMMEnvelopePointList;
  103.     FTempPoint      : TMMEnvelopePoint;
  104.     FKind           : TMMEnvelopeKind;
  105.     FPointSize      : integer;
  106.     FStartIndex     : integer;
  107.     FCurIndex       : integer;
  108.     FUpSelect       : Boolean;
  109.     FShiftBeginX    : Longint; { StartPunkt der MausOperation X values     }
  110.     FShiftBeginY    : Longint; { StartPunkt der MausOperation Y Values     }
  111.     FMinShiftX      : Longint; { max Shiftbereich nach links immer negativ }
  112.     FMaxShiftX      : Longint; { max Shiftbereich nach rechts immer pos.   }
  113.     FMinShiftY      : Longint; { max Shiftbereich nach oben immer negativ  }
  114.     FMaxShiftY      : Longint; { max Shiftbereich nach unten immer pos.    }
  115.     FButton         : TMouseButton;
  116.     FDragOffset     : TPoint;
  117.     FDragRect       : TRect;
  118.     FDragging       : Boolean;
  119.     FMoving         : Boolean;
  120.     FDrawMidLine    : Boolean;
  121.     FMidLineColor   : TColor;
  122.     FLineColor      : TColor;
  123.     FPointColor     : TColor;
  124.     FSelectedColor  : TColor;
  125.     FMoveFirstPoint : Boolean;
  126.     FMoveLastPoint  : Boolean;
  127.     FObservable     : TMMObservable;
  129.     FOnChange       : TNotifyEvent;
  130.     FOnDrawPoint    : TMMEnvelopeDrawPoint;
  132.     procedure SetMovePoints(Index: integer; aValue: Boolean);
  133.     procedure SetKind(aValue: TMMEnvelopeKind);
  134.     procedure SetColors(index: integer; aValue: TColor);
  135.     procedure SetDrawMidLine(aValue: Boolean);
  136.     procedure SetPointSize(aValue: integer);
  137.     procedure SetPoints(aValue: TMMEnvelopePointList);
  138.     function  GetCount: integer;
  139.     function  Get_YValue(X_Value: Longint): Longint;
  140.     function  GetSelected(Index: integer): Boolean;
  141.     procedure SetSelected(Index: integer; aValue: Boolean);
  142.     function  GetSelectedCount: integer;
  143.     procedure CreateInitPoints;
  144.     procedure GetMaxRange(Index: integer; var minX, maxX, minY, maxY: Longint);
  145.     procedure RemapPoints(oldMinX,oldMaxX,oldMinY,oldMaxY: Longint);
  146.     procedure DoChanged(Sender: TObject);
  147.     procedure DrawEnvelopePoints(Canvas: TMMDIBCanvas);
  148.     procedure DrawEnvelope;
  150.   protected
  151.     procedure VLineDoted(aCanvas: TCanvas; x, y1, y2: integer; Clr: TColorRef); override;
  152.     procedure HLineDoted(aCanvas:TCanvas;x1,x2,y:integer;Clr:TColorRef); override;
  153.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  154.                         X, Y: integer); override;
  155.     procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
  156.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  157.                       X, Y: integer); override;
  158.     procedure Paint; override;
  159.     procedure Changed; override;
  160.     procedure RangeChanged; override;
  161.     procedure DrawPoint(Canvas: TCanvas; Rect: TRect; Selected: Boolean); dynamic;
  163.   public
  164.     constructor Create(AOwner: TComponent); override;
  165.     destructor  Destroy; override;
  167.     procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
  169.     procedure AddObserver(O: TMMObserver);
  170.     procedure RemoveObserver(O: TMMObserver);
  172.     procedure SetRangeAll(MinX, MaxX, MinY, MaxY, YBase: Longint); override;
  174.     { TODO: einige Eigenschaften verstecken }
  175.     procedure Clear;
  176.     procedure Reset;
  177.     function  AddPoint(aPoint: TMMEnvelopePoint; Align: Boolean): Boolean;
  178.     procedure DelPoint(Index: integer);
  179.     function  LocatePoint(X_Value: Longint): integer;
  180.     function  FindPoint(X_Value: Longint): integer;
  181.     function  FindPointAtPos(X, Y: integer): integer;
  182.     function  QueryPoint(Point: TMMEnvelopePoint): Boolean;
  183.     procedure DeleteSelected;
  184.     procedure SelectAll(State: Boolean);
  185.     procedure SelectRange(idxA, idxB: integer; State: Boolean);
  186.     procedure SelectArea(Area: TRect; State: Boolean);
  187.     procedure QueryPolyMove(var minX, maxX, minY, maxY: Longint);
  188.     procedure PolyShift(DiffX, DiffY: Longint);
  190.     procedure Scale(Factor: Float);
  192.     property  Count: integer read GetCount;
  193.     property  YValue[X_Value: Longint]: Longint read Get_YValue;
  194.     property  Select[Index: integer]: Boolean read GetSelected write SetSelected;
  195.     property  CurrentIndex: integer read FCurIndex;
  196.     property  SelectedCount: integer read GetSelectedCount;
  198.   published
  199.     { Events }
  200.     property OnClick;
  201.     property OnDblClick;
  202.     property OnMouseDown;
  203.     property OnMouseMove;
  204.     property OnMouseUp;
  205.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  206.     property OnDrawPoint: TMMEnvelopeDrawPoint read FOnDrawPoint write FOnDrawPoint;
  208.     property Align;
  209.     property Bevel;
  210.     property Color default clBtnFace;
  211.     property Width default 200;
  212.     property Height default 100;
  213.     property ParentShowHint;
  214.     property ParentColor default False;
  215.     property ShowHint;
  216.     property Visible;
  217.     property Enabled;
  218.     property Kind: TMMEnvelopeKind read FKind write SetKind default ekRectangle;
  219.     property MidLineColor: TColor index 0 read FMidLineColor write SetColors default clBlack;
  220.     property LineColor: TColor index 1 read FLineColor write SetColors default clBlack;
  221.     property PointColor: TColor index 2 read FPointColor write SetColors default clWhite;
  222.     property SelectedColor: TColor index 3 read FSelectedColor write SetColors default clBlack;
  223.     property PointSize: integer read FPointSize write SetPointSize default 6;
  224.     property DrawMidLine: Boolean read FDrawMidLine write SetDrawMidLine default True;
  225.     property MoveFirstPoint: Boolean index 0 read FMoveFirstPoint write SetMovePoints default True;
  226.     property MoveLastPoint: Boolean index 1 read FMoveLastPoint write SetMovePoints default True;
  227.     property Points: TMMEnvelopePointList read FPoints write SetPoints;
  228.   end;
  230. implementation
  232. const
  233.    STREAMKENNUNG : Longint = $00564E45; { 'ENV ' }
  235. {== TMMEnvelopePoint ====================================================}
  236. constructor TMMEnvelopePoint.Create;
  237. begin
  238.    inherited Create;
  240.    X_Value := 0;
  241.    Y_Value := 0;
  242.    Selected := False;
  243. end;
  245. {-- TMMEnvelopePoint ----------------------------------------------------}
  246. constructor TMMEnvelopePoint.CreateEx(X,Y: integer; Sel: Boolean);
  247. begin
  248.    inherited Create;
  250.    X_Value := X;
  251.    Y_Value := Y;
  252.    Selected := Sel;
  253. end;
  255. {-- TMMEnvelopePoint ----------------------------------------------------}
  256. procedure TMMEnvelopePoint.Store(S: TStream);
  257. begin
  258.    S.WriteBuffer(X_Value,SizeOf(X_Value));
  259.    S.WriteBuffer(Y_Value,SizeOf(Y_Value));
  260.    S.WriteBuffer(Selected,SizeOf(Selected));
  261. end;
  263. {-- TMMEnvelopePoint ----------------------------------------------------}
  264. procedure TMMEnvelopePoint.Load(S: TStream);
  265. begin
  266.    S.ReadBuffer(X_Value,SizeOf(X_Value));
  267.    S.ReadBuffer(Y_Value,SizeOf(Y_Value));
  268.    S.ReadBuffer(Selected,SizeOf(Selected));
  269. end;
  271. {-- TMMEnvelopePoint ----------------------------------------------------}
  272. procedure TMMEnvelopePoint.Assign(Source: TObject);
  273. begin
  274.   if Source is TMMEnvelopePoint then
  275.   begin
  276.      SetParams(TMMEnvelopePoint(Source).X_Value,
  277.                TMMEnvelopePoint(Source).Y_Value,
  278.                TMMEnvelopePoint(Source).Selected);
  279.   end;
  280. end;
  282. {-- TMMEnvelopePoint ----------------------------------------------------}
  283. procedure TMMEnvelopePoint.SetParams(X,Y: integer; Sel: Boolean);
  284. begin
  285.    X_Value := X;
  286.    Y_Value := Y;
  287.    Selected := Sel;
  288. end;
  290. {== TMMEnvelopePointList ================================================}
  291. procedure TMMEnvelopePointList.PutPoint(Index: integer; Point: TMMEnvelopePoint);
  292. begin
  293.    Put(Index, Point);
  294. end;
  296. {-- TMMEnvelopePointList ------------------------------------------------}
  297. function TMMEnvelopePointList.GetPoint(Index: integer): TMMEnvelopePoint;
  298. begin
  299.    Result := TMMEnvelopePoint(Get(Index));
  300. end;
  302. {-- TMMEnvelopePointList ------------------------------------------------}
  303. procedure TMMEnvelopePointList.Assign(Source: TPersistent);
  304. var
  305.    i: integer;
  306.    pt: TMMEnvelopePoint;
  308. begin
  309.    if (Source is TMMEnvelopePointList) or (Source = nil) then
  310.    begin
  311.       BeginUpdate;
  312.       try
  313.          FreeAll;
  314.          if (Source <> nil) then
  315.          for i := 0 to TMMEnvelopePointList(Source).Count-1 do
  316.          begin
  317.             pt := TMMEnvelopePoint.Create;
  318.             pt.Assign(TMMEnvelopePointList(Source)[i]);
  319.             pt.Selected := False;
  320.             AddObject(pt);
  321.          end;
  322.       finally
  323.          EndUpdate;
  324.       end;
  325.       exit;
  326.    end;
  327.    inherited assign(Source);
  328. end;
  330. {-- TMMEnvelopePointList ------------------------------------------------}
  331. procedure TMMEnvelopePointList.ReadData(S: TStream);
  332. Var
  333.    Kennung: Longint;
  334.    ObjCount,
  335.    Index: TOLSize;
  336.    Destroy: Boolean;
  337.    MinX,MaxX,MinY,MaxY: Longint;
  339. begin
  340.    BeginUpdate;
  341.    try
  342.       S.ReadBuffer(Kennung,sizeOf(STREAMKENNUNG));
  343.       if (Kennung <> STREAMKENNUNG) then
  344.          raise EStreamError.Create('Invalid Object stream');
  345.       FreeAll;
  346.       { load stream items }
  347.       S.ReadBuffer(Destroy,SizeOf(Destroy));
  348.       DestroyObjects := Destroy;
  350.       S.ReadBuffer(MinX,SizeOf(MinX));
  351.       S.ReadBuffer(MaxX,SizeOf(MaxX));
  352.       S.ReadBuffer(MinY,SizeOf(MinY));
  353.       S.ReadBuffer(MaxY,SizeOf(MaxY));
  355.       S.ReadBuffer(ObjCount,SizeOf(Objcount));  { Read in Object count }
  356.       { make sure we have not to much points and load only our limit }
  357.       ObjCount := Min(ObjCount,(FEnvelope.RangeMaxX-FEnvelope.RangeMinX)+1);
  358.       if Capacity-Count < ObjCount then Capacity := Count+ObjCount;
  360.       { Read in Object Count }
  361.       for Index := 0 to ObjCount-1 do
  362.       begin
  363.           AddObject(ReadObjectFromStream(S));
  364.           Items[Index].Selected := False;
  365.       end;
  367.       FEnvelope.RemapPoints(MinX,MaxX,MinY,MaxY);
  369.    finally
  370.       EndUpdate;
  371.    end;
  372. end;
  374. {-- TMMEnvelopePointList ------------------------------------------------}
  375. procedure TMMEnvelopePointList.WriteData(S: TStream);
  376. var
  377.    Index,
  378.    ObjCount: TOlSize;
  379.    Destroy: Boolean;
  380.    Value: Longint;
  382. begin
  383.    { Write list to Stream }
  384.    S.WriteBuffer(STREAMKENNUNG,SizeOf(STREAMKENNUNG));
  385.    Destroy := DestroyObjects;
  386.    S.WriteBuffer(Destroy,SizeOf(Destroy));
  388.    Value := FEnvelope.RangeMinX;
  389.    S.WriteBuffer(Value, SizeOf(Value));
  390.    Value := FEnvelope.RangeMaxX;
  391.    S.WriteBuffer(Value, SizeOf(Value));
  392.    Value := FEnvelope.RangeMinY;
  393.    S.WriteBuffer(Value, SizeOf(Value));
  394.    Value := FEnvelope.RangeMaxY;
  395.    S.WriteBuffer(Value, SizeOf(Value));
  397.    ObjCount := Count;
  398.    S.WriteBuffer(ObjCount,SizeOf(ObjCount));
  399.    for Index := 0 to Count-1 do
  400.        WriteObjectToStream(Items[Index],S);
  401. end;
  403. {== TMMEnvelope =========================================================}
  404. constructor TMMEnvelope.Create(AOwner: TComponent);
  405. begin
  406.    inherited Create(AOwner);
  408.    FObservable := TMMObservable.Create;
  410.    FDIBCanvas := TMMDIBCanvas.Create(Self);
  411.    FDIBCanvas.SetBounds(0,0,Width,Height);
  413.    FPoints := TMMEnvelopePointList.Create;
  414.    FPoints.OnChange := DoChanged;
  415.    FPoints.FEnvelope := Self;
  417.    FTempPoint :=  TMMEnvelopePoint.Create;
  419.    FMoveFirstPoint := True;
  420.    FMoveLastPoint := True;
  421.    FKind     := ekRectangle;
  422.    FDragging := False;
  423.    FMoving   := False;
  424.    FUpSelect := False;
  425.    FStartIndex := 0;
  426.    FCurIndex := -1;
  427.    FDrawMidLine := True;
  428.    FMidLineColor := clBlack;
  429.    FLineColor := clBlack;
  430.    FPointColor := clWhite;
  431.    FSelectedColor := clBlack;
  432.    FPointSize := 6;
  434.    Width := 200;
  435.    Height := 100;
  436.    Color := clBtnFace;
  438.    CreateInitPoints;
  440.    ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
  441.    if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
  442. end;
  444. {-- TMMEnvelope ---------------------------------------------------------}
  445. destructor TMMEnvelope.Destroy;
  446. begin
  447.    FDIBCanvas.Free;
  448.    FPoints.Free;
  449.    FTempPoint.Free;
  451.    FObservable.Free;
  452.    FObservable:= nil;
  454.    inherited Destroy;
  455. end;
  457. {-- TMMEnvelope ---------------------------------------------------------}
  458. procedure TMMEnvelope.AddObserver(O: TMMObserver);
  459. begin
  460.    FObservable.AddObserver(O);
  461. end;
  463. {-- TMMEnvelope ---------------------------------------------------------}
  464. procedure TMMEnvelope.RemoveObserver(O: TMMObserver);
  465. begin
  466.    if (FObservable <> nil) then
  467.        FObservable.RemoveObserver(O);
  468. end;
  470. {-- TMMEnvelope ---------------------------------------------------------}
  471. procedure TMMEnvelope.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
  472. var
  473.   W, H: Integer;
  475. begin
  476.    W := Width;
  477.    H := Height;
  478.    inherited SetBounds(aLeft, aTop, aWidth, aHeight);
  480.    if ((W <> Width) or (H <> Height)) and
  481.       (Width > 0) and (Height > 0) and (FDIBCanvas <> nil) then
  482.    begin
  483.       FDIBCanvas.SetBounds(0,0,Width,Height);
  484.       Invalidate;
  485.    end;
  486. end;
  488. {-- TMMEnvelope ---------------------------------------------------------}
  489. procedure TMMEnvelope.SetPoints(aValue: TMMEnvelopePointList);
  490. begin
  491.    if (aValue <> FPoints) then FPoints.Assign(aValue);
  492. end;
  494. {-- TMMEnvelope ---------------------------------------------------------}
  495. procedure TMMEnvelope.DoChanged(Sender: TObject);
  496. begin
  497.    Changed;
  498. end;
  500. {-- TMMEnvelope ---------------------------------------------------------}
  501. procedure TMMEnvelope.Changed;
  502. begin
  503.    inherited Changed;
  505.    if not (csReading in ComponentState) and
  506.       not (csLoading in ComponentState) then
  507.    begin
  509.       { go trough the list and notify }
  510.       FObservable.NotifyObservers(Self);
  512.       if assigned(FOnChange) then FOnChange(Self);
  513.    end;
  514. end;
  516. {-- TMMEnvelope ---------------------------------------------------------}
  517. procedure TMMEnvelope.SetRangeAll(MinX, MaxX, MinY, MaxY, YBase: Longint);
  518. var
  519.    oldMinX,oldMaxX,oldMinY,oldMaxY: Longint;
  521. begin
  522.    if (MinX > MaxX) then SwapLong(MinX, MaxX);
  523.    if (MinY > MaxY) then SwapLong(MinY, MaxY);
  525.    if (MinX <> RangeMinX) or (MaxX <> RangeMaxX) or
  526.       (MinY <> RangeMinY) or (MaxY <> RangeMaxY) or
  527.       (YBase <> BaseY) then
  528.    begin
  529.       oldMinX := RangeMinX;
  530.       oldMaxX := RangeMaxX;
  531.       oldMinY := RangeMinY;
  532.       oldMaxY := RangeMaxY;
  534.       inherited SetRangeAll(MinX,MaxX,MinY,MaxY,YBase);
  536.       RemapPoints(oldMinX,oldMaxX,oldMinY,oldMaxY);
  537.       Invalidate;
  538.    end;
  539. end;
  541. {-- TMMEnvelope ---------------------------------------------------------}
  542. procedure TMMEnvelope.RemapPoints(oldMinX,oldMaxX,oldMinY,oldMaxY: Longint);
  543. var
  544.    i: integer;
  546. begin
  547.    if Count > 0 then
  548.    for i := 0 to Count-1 do
  549.    begin
  550.       with Points[i] do
  551.       begin
  552.          if (i = 0) then
  553.             X_Value := RangeMinX
  554.          else if (i = Count-1) then
  555.             X_Value := RangeMaxX
  556.          else
  557.             X_Value := Limit(MulDiv32(X_Value-oldMinX,RangeMaxX-RangeMinX,oldMaxX-oldMinX)+RangeMinX,RangeMinX,RangeMaxX);
  558.          Y_Value := Limit(MulDiv32(Y_Value-oldMinY,RangeMaxY-RangeMinY,oldMaxY-oldMinY)+RangeMinY,RangeMinY,RangeMaxY);
  559.       end;
  560.       Changed;
  561.    end;
  562. end;
  564. {-- TMMEnvelope ---------------------------------------------------------}
  565. procedure TMMEnvelope.Scale(Factor: Float);
  566. var
  567.    i: integer;
  568.    von, bis: integer;
  569.    FactorMin, FactorMax: Float;
  570.    Lim1, Lim2: Float;
  572. begin
  573.    FactorMin := -MaxLongint;
  574.    FactorMax := +MaxLongint;
  576.    von := ord(not FMoveFirstPoint);
  577.    bis := Count-(1+ord(not FMoveLastPoint));
  578.    for i := von to bis do
  579.    if Points[i].Y_Value <> 0 then
  580.    begin
  581.       Lim1 := RangeMinY / Points[i].Y_Value;
  582.       Lim2 := RangeMaxY / Points[i].Y_Value;
  583.       FactorMax := LimitR(FactorMax, Lim1, Lim2);
  584.       FactorMin := LimitR(FactorMin, Lim1, Lim2);
  585.    end;
  587.    Factor := LimitR(Factor, FactorMin, FactorMax);
  589.    if (Factor <> 1.0) then
  590.    begin
  591.       for i := von to bis do
  592.           Points[i].Y_Value := Round(Factor * Points[i].Y_Value);
  593.       Changed;
  594.    end;
  595. end;
  597. {-- TMMEnvelope ---------------------------------------------------------}
  598. function TMMEnvelope.GetCount: integer;
  599. begin
  600.    Result := FPoints.Count;
  601. end;
  603. {-- TMMEnvelope ---------------------------------------------------------}
  604. procedure TMMEnvelope.CreateInitPoints;
  605. begin
  606.    FTempPoint.X_Value := RangeMinX;
  607.    FTempPoint.Y_Value := BaseY;
  608.    FTempPoint.Selected := False;
  609.    AddPoint(FTempPoint,False);
  611.    FTempPoint.X_Value := RangeMaxX;
  612.    FTempPoint.Y_Value := BaseY;
  613.    FTempPoint.Selected := False;
  614.    AddPoint(FTempPoint,False);
  615.    {$IFDEF WIN32}
  616.    {$IFDEF TRIAL}
  617.    {$DEFINE _HACK1}
  618.    {$I MMHACK.INC}
  619.    {$ENDIF}
  620.    {$ENDIF}
  621. end;
  623. {-- TMMEnvelope ---------------------------------------------------------}
  624. { AddPoint f黦t einen Punkt in die Liste ein, AddPoint erzeugt eine Kopie}
  625. function TMMEnvelope.AddPoint(aPoint: TMMEnvelopePoint; Align: Boolean): Boolean;
  626. var
  627.   i: integer;
  628.   NewPoint: TMMEnvelopePoint;
  630. begin
  631.    Result := False;
  632.    if QueryPoint(aPoint) then   { passt hier Punkt ueberhaupt hin ? }
  633.    begin
  634.       NewPoint := TMMEnvelopePoint.Create;
  635.       NewPoint.Assign(aPoint);
  637.       i := LocatePoint(NewPoint.X_Value);
  638.       if (i < 1) or (i >= Count) then Points.AddObject(NewPoint)
  639.       else
  640.       begin
  641.          { neuen Punkt genau auf Linie zwischen zwei Punken einf黦en }
  642.          if Align then
  643.          with NewPoint do
  644.          begin
  645.             { Stefans Dreisatz oder wei