mmenvelp.pas

一套及时通讯的原码

      end;
      exit;
   end;
   inherited assign(Source);
end;

{-- TMMEnvelopePointList ------------------------------------------------}
procedure TMMEnvelopePointList.ReadData(S: TStream);
Var
   Kennung: Longint;
   ObjCount,
   Index: TOLSize;
   Destroy: Boolean;
   MinX,MaxX,MinY,MaxY: Longint;

begin
   BeginUpdate;
   try
      S.ReadBuffer(Kennung,sizeOf(STREAMKENNUNG));
      if (Kennung <> STREAMKENNUNG) then
         raise EStreamError.Create('Invalid Object stream');
      FreeAll;
      { load stream items }
      S.ReadBuffer(Destroy,SizeOf(Destroy));
      DestroyObjects := Destroy;

      S.ReadBuffer(MinX,SizeOf(MinX));
      S.ReadBuffer(MaxX,SizeOf(MaxX));
      S.ReadBuffer(MinY,SizeOf(MinY));
      S.ReadBuffer(MaxY,SizeOf(MaxY));

      S.ReadBuffer(ObjCount,SizeOf(Objcount));  { Read in Object count }
      { make sure we have not to much points and load only our limit }
      ObjCount := Min(ObjCount,(FEnvelope.RangeMaxX-FEnvelope.RangeMinX)+1);
      if Capacity-Count < ObjCount then Capacity := Count+ObjCount;

      { Read in Object Count }
      for Index := 0 to ObjCount-1 do
      begin
          AddObject(ReadObjectFromStream(S));
          Items[Index].Selected := False;
      end;

      FEnvelope.RemapPoints(MinX,MaxX,MinY,MaxY);

   finally
      EndUpdate;
   end;
end;

{-- TMMEnvelopePointList ------------------------------------------------}
procedure TMMEnvelopePointList.WriteData(S: TStream);
var
   Index,
   ObjCount: TOlSize;
   Destroy: Boolean;
   Value: Longint;

begin
   { Write list to Stream }
   S.WriteBuffer(STREAMKENNUNG,SizeOf(STREAMKENNUNG));
   Destroy := DestroyObjects;
   S.WriteBuffer(Destroy,SizeOf(Destroy));

   Value := FEnvelope.RangeMinX;
   S.WriteBuffer(Value, SizeOf(Value));
   Value := FEnvelope.RangeMaxX;
   S.WriteBuffer(Value, SizeOf(Value));
   Value := FEnvelope.RangeMinY;
   S.WriteBuffer(Value, SizeOf(Value));
   Value := FEnvelope.RangeMaxY;
   S.WriteBuffer(Value, SizeOf(Value));

   ObjCount := Count;
   S.WriteBuffer(ObjCount,SizeOf(ObjCount));
   for Index := 0 to Count-1 do
       WriteObjectToStream(Items[Index],S);
end;

{== TMMEnvelope =========================================================}
constructor TMMEnvelope.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   FObservable := TMMObservable.Create;

   FDIBCanvas := TMMDIBCanvas.Create(Self);
   FDIBCanvas.SetBounds(0,0,Width,Height);

   FPoints := TMMEnvelopePointList.Create;
   FPoints.OnChange := DoChanged;
   FPoints.FEnvelope := Self;

   FTempPoint :=  TMMEnvelopePoint.Create;

   FMoveFirstPoint := True;
   FMoveLastPoint := True;
   FKind     := ekRectangle;
   FDragging := False;
   FMoving   := False;
   FUpSelect := False;
   FStartIndex := 0;
   FCurIndex := -1;
   FDrawMidLine := True;
   FMidLineColor := clBlack;
   FLineColor := clBlack;
   FPointColor := clWhite;
   FSelectedColor := clBlack;
   FPointSize := 6;

   Width := 200;
   Height := 100;
   Color := clBtnFace;

   CreateInitPoints;

   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{-- TMMEnvelope ---------------------------------------------------------}
destructor TMMEnvelope.Destroy;
begin
   FDIBCanvas.Free;
   FPoints.Free;
   FTempPoint.Free;

   FObservable.Free;
   FObservable:= nil;

   inherited Destroy;
end;

{-- TMMEnvelope ---------------------------------------------------------}
procedure TMMEnvelope.AddObserver(O: TMMObserver);
begin
   FObservable.AddObserver(O);
end;

{-- TMMEnvelope ---------------------------------------------------------}
procedure TMMEnvelope.RemoveObserver(O: TMMObserver);
begin
   if (FObservable <> nil) then
       FObservable.RemoveObserver(O);
end;

{-- TMMEnvelope ---------------------------------------------------------}
procedure TMMEnvelope.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
var
  W, H: Integer;

begin
   W := Width;
   H := Height;
   inherited SetBounds(aLeft, aTop, aWidth, aHeight);

   if ((W <> Width) or (H <> Height)) and
      (Width > 0) and (Height > 0) and (FDIBCanvas <> nil) then
   begin
      FDIBCanvas.SetBounds(0,0,Width,Height);
      Invalidate;
   end;
end;

{-- TMMEnvelope ---------------------------------------------------------}
procedure TMMEnvelope.SetPoints(aValue: TMMEnvelopePointList);
begin
   if (aValue <> FPoints) then FPoints.Assign(aValue);
end;

{-- TMMEnvelope ---------------------------------------------------------}
procedure TMMEnvelope.DoChanged(Sender: TObject);
begin
   Changed;
end;

{-- TMMEnvelope ---------------------------------------------------------}
procedure TMMEnvelope.Changed;
begin
   inherited Changed;

   if not (csReading in ComponentState) and
      not (csLoading in ComponentState) then
   begin

      { go trough the list and notify }
      FObservable.NotifyObservers(Self);

      if assigned(FOnChange) then FOnChange(Self);
   end;
end;

{-- TMMEnvelope ---------------------------------------------------------}
procedure TMMEnvelope.SetRangeAll(MinX, MaxX, MinY, MaxY, YBase: Longint);
var
   oldMinX,oldMaxX,oldMinY,oldMaxY: Longint;

begin
   if (MinX > MaxX) then SwapLong(MinX, MaxX);
   if (MinY > MaxY) then SwapLong(MinY, MaxY);

   if (MinX <> RangeMinX) or (MaxX <> RangeMaxX) or
      (MinY <> RangeMinY) or (MaxY <> RangeMaxY) or
      (YBase <> BaseY) then
   begin
      oldMinX := RangeMinX;
      oldMaxX := RangeMaxX;
      oldMinY := RangeMinY;
      oldMaxY := RangeMaxY;

      inherited SetRangeAll(MinX,MaxX,MinY,MaxY,YBase);

      RemapPoints(oldMinX,oldMaxX,oldMinY,oldMaxY);
      Invalidate;
   end;
end;

{-- TMMEnvelope ---------------------------------------------------------}
procedure TMMEnvelope.RemapPoints(oldMinX,oldMaxX,oldMinY,oldMaxY: Longint);
var
   i: integer;

begin
   if Count > 0 then
   for i := 0 to Count-1 do
   begin
      with Points[i] do
      begin
         if (i = 0) then
            X_Value := RangeMinX
         else if (i = Count-1) then
            X_Value := RangeMaxX
         else
            X_Value := Limit(MulDiv32(X_Value-oldMinX,RangeMaxX-RangeMinX,oldMaxX-oldMinX)+RangeMinX,RangeMinX,RangeMaxX);
         Y_Value := Limit(MulDiv32(Y_Value-oldMinY,RangeMaxY-RangeMinY,oldMaxY-oldMinY)+RangeMinY,RangeMinY,RangeMaxY);
      end;
      Changed;
   end;
end;

{-- TMMEnvelope ---------------------------------------------------------}
procedure TMMEnvelope.Scale(Factor: Float);
var
   i: integer;
   von, bis: integer;
   FactorMin, FactorMax: Float;
   Lim1, Lim2: Float;

begin
   FactorMin := -MaxLongint;
   FactorMax := +MaxLongint;

   von := ord(not FMoveFirstPoint);
   bis := Count-(1+ord(not FMoveLastPoint));
   for i := von to bis do
   if Points[i].Y_Value <> 0 then
   begin
      Lim1 := RangeMinY / Points[i].Y_Value;
      Lim2 := RangeMaxY / Points[i].Y_Value;
      FactorMax := LimitR(FactorMax, Lim1, Lim2);
      FactorMin := LimitR(FactorMin, Lim1, Lim2);
   end;

   Factor := LimitR(Factor, FactorMin, FactorMax);

   if (Factor <> 1.0) then
   begin
      for i := von to bis do
          Points[i].Y_Value := Round(Factor * Points[i].Y_Value);
      Changed;
   end;
end;

{-- TMMEnvelope ---------------------------------------------------------}
function TMMEnvelope.GetCount: integer;
begin
   Result := FPoints.Count;
end;

{-- TMMEnvelope ---------------------------------------------------------}
procedure TMMEnvelope.CreateInitPoints;
begin
   FTempPoint.X_Value := RangeMinX;
   FTempPoint.Y_Value := BaseY;
   FTempPoint.Selected := False;
   AddPoint(FTempPoint,False);

   FTempPoint.X_Value := RangeMaxX;
   FTempPoint.Y_Value := BaseY;
   FTempPoint.Selected := False;
   AddPoint(FTempPoint,False);
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMEnvelope ---------------------------------------------------------}
{ AddPoint f黦t einen Punkt in die Liste ein, AddPoint erzeugt eine Kopie}
function TMMEnvelope.AddPoint(aPoint: TMMEnvelopePoint; Align: Boolean): Boolean;
var
  i: integer;
  NewPoint: TMMEnvelopePoint;

begin
   Result := False;
   if QueryPoint(aPoint) then   { passt hier Punkt ueberhaupt hin ? }
   begin
      NewPoint := TMMEnvelopePoint.Create;
      NewPoint.Assign(aPoint);

      i := LocatePoint(NewPoint.X_Value);
      if (i < 1) or (i >= Count) then Points.AddObject(NewPoint)
      else
      begin
         { neuen Punkt genau auf Linie zwischen zwei Punken einf黦en }
         if Align then
         with NewPoint do
         begin
            { Stefans Dreisatz oder wei