mmpanel.pas

一套及时通讯的原码

       property PopupMenu;
       property ShowHint;
       property TabOrder;
       property TabStop;
       property Visible;

       property AutoScroll;
       property CorralLocator;
       property UseHelpLocator;
       property UseLocator;
       property UseMarkers;
       property HelpLocator;
       property Locator;
       property GridWidthX;
       property GridWidthY;
       property SnapToGrid;
       property SnapRange;
       property MarkerA;
       property MarkerB;
       property LocatorColor;
       property MarkerAColor;
       property MarkerBColor;
       property GridColor;
       property DrawSolid;
       property DrawGriff;
       property DrawGridX;
       property DrawGridY;
       property RangeMinX;
       property RangeMaxX;
       property RangeMinY;
       property RangeMaxY;
       property BaseY;
       property DispMinX;
       property DispMaxX;
       property DispMinY;
       property DispMaxY;
       property DefaultHint;
    end;

implementation

const
    GriffWidth = 10;
    ButtonDown : Boolean = False;

{== TMMBorder ============================================================}
constructor TMMBorder.Create(aOwner: TComponent);
begin
     inherited Create(aOwner);

     Width  := 185;
     Height := 41;

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

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

   ControlStyle   := ControlStyle - [csSetCaption,csAcceptsControls];

   FMarkerList    := nil;

   FMarkerAMap    := nil;
   FMarkerBMap    := nil;
   FLocatorMap    := nil;

   FShowHints     := ShowHint;
   FOriginalCursor:= Cursor;
   FCanUpdate     := True;
   FAutoScroll    := True;
   FMarkerShift   := mkNone;
   FUseHelpLocator:= True;
   FUseLocator    := False;
   FUseMarkers    := False;
   FCorralLocator := True;
   FRangeMinX     := 0;
   FRangeMaxX     := 1000;
   FRangeMinY     := 0;
   FRangeMaxY     := 1000;
   FBaseY         := 500;
   FDispMinX      := 0;
   FDispMaxX      := 1000;
   FDispMinY      := 0;
   FDispMaxY      := 1000;

   FGridWidthX    := 100;
   FGridWidthY    := 100;
   FSnapToGrid    := False;
   FSnapRange     := 3;

   FHelpLocator   := -1;
   FLastHelpLoc   := -1;
   FHelpLocColor  := clSilver;

   FLocator       := -1;
   FLastLoc       := -1;
   FLocColor      := clLime;

   FMarkerA       := -1;
   FLastMarkA     := -1;
   FMarkAColor    := clRed;

   FMarkerB       := -1;
   FLastMarkB     := -1;
   FMarkBColor    := clRed;

   FGridColor     := clGray;
   FDrawSolid     := False;
   FDrawGriff     := False;
   FDrawGridX     := False;
   FDrawGridY     := False;
   FDragging      := False;
   UseLocator     := True;

   FLocked        := False;
   FDefaultHint   := '';

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

{-- TMMCustomMarkerPanel ------------------------------------------------}
destructor TMMCustomMarkerPanel.Destroy;
begin
   if assigned(FLocatorMap) then FLocatorMap.Free;
   if assigned(FMarkerAMap) then FMarkerAMap.Free;
   if assigned(FMarkerBMap) then FMarkerBMap.Free;

   FMarkerList := nil;

   inherited Destroy;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetMarkerList(aList: TMMMarkerList);
begin
   FMarkerList := aList;
   Invalidate;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetRangeMinX(aValue: Longint);
begin
   SetRangeAll(aValue, FRangeMaxX, FRangeMinY, FRangeMaxY, FBaseY);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetRangeMaxX(aValue: Longint);
begin
   SetRangeAll(FRangeMinX, aValue, FRangeMinY, FRangeMaxY, FBaseY);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetRangeMinY(aValue: Longint);
begin
   SetRangeAll(FRangeMinX, FRangeMaxX, aValue, FRangeMaxY, FBaseY);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetRangeMaxY(aValue: Longint);
begin
   SetRangeAll(FRangeMinX, FRangeMaxX, FRangeMinY, aValue, FBaseY);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetBaseY(aValue: Longint);
begin
   SetRangeAll(FRangeMinX, FRangeMaxX, FRangeMinY, FRangeMaxY, aValue);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetRangeAll(MinX, MaxX, MinY, MaxY, YBase: Longint);
begin
   if (MinX > MaxX) then SwapLong(MinX, MaxX);
   if (MinY > MaxY) then SwapLong(MinY, MaxY);

   if (MinX <> FRangeMinX) or (MaxX <> FRangeMaxX) or
      (MinY <> FRangeMinY) or (MaxY <> FRangeMaxY) or
      (YBase <> FBaseY) then
   begin
      FRangeMinX := MinX;
      FRangeMaxX := Max(MaxX,MinX+1);
      FRangeMinY := MinY;
      FRangeMaxY := Max(MaxY,MinY+1);

      FBaseY := Limit(YBase, FRangeMinY, FRangeMaxY);

      SetDispAll(Limit(FDispMinX, FRangeMinX, FRangeMaxX),
                 Max(Limit(FDispMaxX, FRangeMinX, FRangeMaxX),FDispMinX+1),
                 Limit(FDispMinY, FRangeMinY, FRangeMaxY),
                 Max(Limit(FDispMaxY, FRangeMinY, FRangeMaxY),FDispMinY+1));
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
    {$ENDIF}
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetDispMinX(aValue: Longint);
begin
   SetDispAll(aValue,FDispMaxX, FDispMinY, FDispMaxY);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetDispMaxX(aValue: Longint);
begin
   SetDispAll(FDispMinX,aValue,FDispMinY,FDispMaxY);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetDispMinY(aValue: Longint);
begin
   SetDispAll(FDispMinX,FDispMaxX, aValue, FDispMaxY);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetDispMaxY(aValue: Longint);
begin
   SetDispAll(FDispMinX,FDispMaxX,FDispMinY,aValue);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetMinMax(Min, Max: Longint);
begin
   SetDispAll(Min,Max,FDispMinY,FDispMaxY);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetMinMaxY(Min, Max: Longint);
begin
   SetDispAll(FDispMinX,FDispMaxX,Min,Max);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetDispAll(MinX, MaxX, MinY, MaxY: Longint);
begin
   if (MinX > MaxX) then SwapLong(MinX, MaxX);
   if (MinY > MaxY) then SwapLong(MinY, MaxY);

   if (MinX <> FDispMinX) or (MaxX <> FDispMaxX) or
      (MinY <> FDispMinY) or (MaxY <> FDispMaxY) then
   begin
      CheckRange(MinX,MaxX,FRangeMinX,FRAngeMaxX,Width-2*BevelExtend);
      FDispMinX := MinX;
      FDispMaxX := MaxX;

      CheckRange(MinY,MaxY,FRangeMinY,FRangeMaxY,Height-2*BevelExtend);
      FDispMinY := MinY;
      FDispMaxY := MaxY;

      RangeChanged;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.AdjustVisibleRange(Value: Longint): Boolean;
var
   min, max: Longint;
   pixel: integer;
   aPos: TPoint;

begin
   Result := False;

   { pa遲 den sichtbaren Bereich aller Elemente an (scrolling) }
   if (Value >= RangeMinX) then
   begin
      pixel := X_ToPixel(Value);
      if (pixel > Width-BevelExtend-5) and (DispMaxX < RangeMaxX) then
      begin
         max := limit(Value+(DispMaxX-DispMinX)div 2,RangeMinX,RangeMaxX);
         min := max-(DispMaxX-DispMinX);
         SetMinMax(min, max);

         Update;

         GetCursorPos(aPos);
         aPos.X := ClientToScreen(Point(X_ToPixel(Value),0)).X;
         SetCursorPos(aPos.X,aPos.Y);
         Result := True;
      end
      else if (pixel < BevelExtend+5) and (DispMinX > RangeMinX) then
      begin
         min := limit(Value-(DispMaxX-DispMinX)div 2,RangeMinX,RangeMaxX);
         max := min+(DispMaxX-DispMinX);
         SetMinMax(min, max);

         Update;

         GetCursorPos(aPos);
         aPos.X := ClientToScreen(Point(X_ToPixel(Value),0)).X;
         SetCursorPos(aPos.X,aPos.Y);
         Result := True
      end;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.CheckRange(var lMin,lMax: Longint; MinRange,MaxRange,MinDistance: Longint);
var
   Diff: Longint;

begin
   if (lMax < lMin) then SwapLong(lMax,lMin);

   lMax := Max(lMax, lMin+MinDistance);

   if (lMax > MaxRange) then
   begin
      Diff := lMax-lMin;
      lMax := MaxRange;
      lMin := Max(lMax-Diff,MinRange);
   end
   else if (lMin < MinRange) then
   begin
      Diff := lMax-lMin;
      lMin := MinRange;
      lMax := Min(lMin+Diff,MaxRange);
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.X_ToPixelNoLimit(X_Value: Longint): Longint;
begin
{$IFDEF FLOATCALC}
   Result := BevelExtend+Round((X_Value-DispMinX)/(DispMaxX-DispMinX)*((Width-2*BevelExtend)-1));
{$ELSE}
   Result := BevelExtend+MulDiv32(X_Value-DispMinX,(Width-2*BevelExtend)-1,DispMaxX-DispMinX);
{$ENDIF}
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.X_ToPixel(X_Value: Longint): integer;
begin
   Result := Limit(X_ToPixelNoLimit(X_Value),-16384,16384);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.PixelTo_X(X: integer): Longint;
begin
{$IFDEF FLOATCALC}
   Result := Round((X-BevelExtend)/((Width-2*BevelExtend)-1)*(DispMaxX-DispMinX))+DispMinX;
{$ELSE}
   Result := MulDiv32(X-BevelExtend,DispMaxX-DispMinX,(Width-2*BevelExtend)-1)+DispMinX;
{$ENDIF}
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.Y_ToPixelNoLimit(Y_Value: Longint): Longint;
begin
{$IFDEF FLOATCALC}
   Result := ((Height-BevelExtend)-1)-Round((Y_Value-DispMinY)/(DispMaxY-DispMinY)*((Height-2*BevelExtend)-1));
{$ELSE}
   Result := ((Height-BevelExtend)-1)-MulDiv32(Y_Value-DispMinY,(Height-2*BevelExtend)-1,DispMaxY-DispMinY);
{$ENDIF}
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.Y_ToPixel(Y_Value: Longint): integer;
begin
   Result := Limit(Y_ToPixelNoLimit(Y_Value),-16384,16384);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.PixelTo_Y(Y: integer): Longint;
begin
{$IFDEF FLOATCALC}
   Result := Round((((Height-BevelExtend)-1)-Y)/((Height-2*BevelExtend)-1)*(DispMaxY-DispMinY))+DispMinY;
{$ELSE}
   Result := MulDiv32(((Height-BevelExtend)-1)-Y,DispMaxY-DispMinY,(Height-2*BevelExtend)-1)+DispMinY;
{$ENDIF}
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetColors(Index: integer; aValue: TColor);
begin
   case Index of
        0: if FHelpLocColor = aValue then exit else FHelpLocColor := aValue;
        1: if FLocColor = aValue then exit else FLocColor := aValue;