mmpanel.pas

一套及时通讯的原码

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.IsLocator(X: integer): Boolean;
var
   x1: Longint;
begin
   x1 := X_ToPixel(FLocator);
   Result := FUseLocator and (FLocator >= 0) and
             (X >= x1-SNAPRANGE) and
             (X <= x1+SNAPRANGE) and
             (X >= 0) and (X <= Width);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.IsMarkerA(X: integer): Boolean;
var
   x1: Longint;
begin
   x1 := X_ToPixel(FMarkerA);
   Result := FUseMarkers and (FMarkerA >= 0) and
             (X >= x1-SNAPRANGE-1) and
             (X <= x1+SNAPRANGE) and
             (X >= 0) and (X <= Width);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.IsMarkerB(X: integer): Boolean;
var
   x1: Longint;
begin
   x1 := X_ToPixel(FMarkerB);
   Result := FUseMarkers and (FMarkerB >= 0) and
             (X >= x1-SNAPRANGE) and
             (X <= x1+SNAPRANGE+1) and
             (X >= 0) and (X <= Width);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.FindListMarker(X: integer): integer;
var
   i: integer;
begin
   Result := -1;
   if (FMarkerList <> nil) and (FMarkerList.Count > 0) then
   with FMarkerList do
   begin
      i := LocateMarker(PixelTo_X(X));
      if (i < Count) and
         (X >= X_ToPixel(Markers[i]^.Offset)-SNAPRANGE) and
         (X <= X_ToPixel(Markers[i]^.Offset)+SNAPRANGE) and
          Markers[i]^.Visible then
      begin
         Result := i;
      end
      else if (i > 0) and
              (X >= X_ToPixel(Markers[i-1]^.Offset)-SNAPRANGE) and
              (X <= X_ToPixel(Markers[i-1]^.Offset)+SNAPRANGE) and
               Markers[i-1]^.Visible then
      begin
         Result := i-1;
      end;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.IsListMarker(X: integer): Boolean;
var
   index: integer;
begin
   index := FindListMarker(X);

   Result := (index >= 0) and not FMarkerList.Markers[index]^.Fixed;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.IsGridX(X: integer; var Value: Longint): Boolean;
var
   g: Longint;

begin
   Value := PixelTo_X(X);
   if FSnapToGrid and inMinMax(Value,DispMinX,DispMaxX) then
   begin
      g := Trunc(Trunc(Value/FGridWidthX)*FGridwidthX);
      { left }
      if (X - X_ToPixel(g) <= SNAPRANGE) then
      begin
         Result := True;
         Value := g;
         exit;
      end;
      { right }
      g := Trunc((Trunc(Value/FGridWidthX)+1)*FGridwidthX);
      if (X_ToPixel(g)-X <= SNAPRANGE) then
      begin
         Result := True;
         Value := g;
         exit;
      end;
   end;
   Result := False;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.IsGridY(Y: integer; var Value: Longint): Boolean;
var
   g: Longint;

begin
   Value := PixelTo_Y(Y);
   if FSnapToGrid and inMinMax(Value,DispMinY,DispMaxY) then
   begin
      g := Trunc(Trunc(Value/FGridWidthY)*FGridWidthY);
      { top }
      if (Y_ToPixel(g)-Y <= SNAPRANGE) then
      begin
         Result := True;
         Value := g;
         exit;
      end;
      { bottom }
      g := Trunc((Trunc(Value/FGridWidthY)+1)*FGridwidthY);
      if (Y-Y_ToPixel(g) <= SNAPRANGE) then
      begin
         Result := True;
         Value := g;
         exit;
      end;
   end;
   Result := False;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.WMLButtonDown(var Message: TWMLButtonDown);
begin
   ButtonDown   := True;
   FLButtonDown := True;

   if not FRButtonDown then inherited;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.WMLButtonUp(var Message: TWMLButtonUp);
begin
   ButtonDown   := False;
   FLButtonDown := False;

   if not FRButtonDown then inherited;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.WMRButtonDown(var Message: TWMRButtonDown);
begin
   ButtonDown   := True;
   FRButtonDown := True;

   if not FLButtonDown then inherited;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.WMRButtonUp(var Message: TWMRButtonUp);
begin
   ButtonDown   := False;
   FRButtonDown := False;

   if not FLButtonDown then inherited;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.WMCancelMode(var Message: TWMCancelMode);
var
   P: TPoint;

begin
   if FLButtonDown or FRButtonDown then
   begin
      GetCursorPos(P);
      P := ClientToScreen(P);

      if FLButtonDown then
         Perform(WM_LBUTTONUP, 0, Longint(PointToSmallPoint(P)));

      if FRButtonDown then
         Perform(WM_RBUTTONUP, 0, Longint(PointToSmallPoint(P)));
   end;

   inherited;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.MouseAction(Button: TMouseButton; X: integer): TMarkerShift;
begin
   Result := mkNone;

   if FUseLocator and (Button = mbLeft) and IsLocator(X) then
   begin
      Result := mkLocator;
      exit;                        { Locator }
   end;

   if FUseMarkers then
   begin
      if IsMarkerA(X) then
      begin
         if (Button = mbLeft) then Result := mkMarkerA
         else Result := mkMarkerAB;
         exit;
      end;

      if IsMarkerB(X) then
      begin
         if (Button = mbLeft) then Result := mkMarkerB
         else Result := mkMarkerBA;
         exit;
      end;
   end;

   if (Button = mbLeft) and IsListMarker(X) then
   begin
      Result := mkListMarker;
      exit;                        { MarkerList }
   end;
end;

const
     inHandler: integer = 0; { verhinder Rekursion durch 2x WM_LBUTTONDOWN }

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.MouseDown(Button: TMouseButton; Shift: TShiftState;
                                   X, Y: integer);
var
   P: TPoint;

begin
   if not FDragging and not FLocked then
   begin
      FMarkerShift := MouseAction(Button, X);
      if (FMarkerShift <> mkNone) then
      begin
         if (Button=mbLeft)or((Button=mbRight)and(FMarkerShift<>mkLocator)) then
         begin
            if (FMarkerShift = mkListMarker) then
                FCurMarker := FindListMarker(X);

            MouseCapture := True;
            FButton := Button;
            FDragging := True;
            TrackBegin;
            exit;
         end;
      end
      else if (inHandler = 0) then
      begin
         inc(inHandler);
         FButton := Button;
         if (Button = mbLeft) and FUseLocator then
         begin
           { Locator neu setzen }
           if FUseMarkers and FCorralLocator then
              LocatorChanged(Limit(PixelTo_X(X),MarkerA,MarkerB))
           else
              LocatorChanged(Limit(PixelTo_X(X),DispMinX,DispMaxX));
           { !!! Trick 17 !!! }
           P := Point(X,Y);
           Perform(WM_LBUTTONUP, 0, Longint(PointToSmallPoint(P)));
           Perform(WM_MOUSEMOVE, 0, Longint(PointToSmallPoint(P)));
           Perform(WM_LBUTTONDOWN, 0, Longint(PointToSmallPoint(P)));
         end;

         dec(inHandler);
      end;
   end;

   inherited MouseDown(Button, Shift, X,Y);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.MouseMove(Shift: TShiftState; X,Y: integer);
var
  NewPos,NewPos2: Longint;
  OnePixel: Longint;

begin
   if FDragging and (FMarkerShift <> mkNone) then
   begin
      OnePixel := PixelTo_X(1)-PixelTo_X(0);
      isGridX(X,NewPos);
      case FMarkerShift of
         mkLocator:
         begin
            if UseMarkers and FCorralLocator then
               LocatorChanged(Limit(NewPos,MarkerA,MarkerB))
            else
               LocatorChanged(Limit(NewPos,DispMinX,DispMaxX));
         end;
         mkMarkerA:
         begin
            if UseLocator and FCorralLocator then
               NewPos := Limit(NewPos, DispMinX,Locator-OnePixel)
            else
               NewPos := Limit(NewPos, DispMinX,MarkerB-OnePixel);

            if (NewPos <> MarkerA) then
            begin
               MarkerAChanged(NewPos);
            end;
         end;
         mkMarkerB:
         begin
            if UseLocator and FCorralLocator then
               NewPos := Limit(NewPos, Locator+OnePixel,DispMaxX)
            else
               NewPos := Limit(NewPos, MarkerA+OnePixel,DispMaxX);

            if (NewPos <> MarkerB) then
            begin
               MarkerBChanged(NewPos);
            end;
         end;
         mkMarkerAB:
         begin
            if UseLocator and FCorralLocator then
               NewPos := Limit(NewPos,
                               Max(DispMinX,(Locator+OnePixel)-(MarkerB-MarkerA)),
                               Min(Locator-OnePixel,RangeMaxX-(MarkerB-MarkerA)))
            else
               NewPos := Limit(NewPos,DispMinX,RangeMaxX-(MarkerB-MarkerA));

            if (NewPos <> MarkerA) then
            begin
               if isGridX(X_ToPixel(NewPos+(MarkerB-MarkerA)),NewPos2) then
               begin
                  if UseLocator and FCorralLocator then
                     NewPos := Limit(NewPos + (NewPos2-(NewPos+(MarkerB-MarkerA))),
                                     Max(DispMinX,(Locator+OnePixel)-(MarkerB-MarkerA)),
                                     Min(Locator-OnePixel,RangeMaxX-(MarkerB-MarkerA)))
                  else
                     NewPos := Limit(NewPos + (NewPos2-(NewPos+(MarkerB-MarkerA))),
                                     DispMinX,RangeMaxX-(MarkerB-MarkerA));

                  if (NewPos = MarkerA) then exit;
               end;
               MarkersChanged(FMarkerShift,NewPos,NewPos+(MarkerB-MarkerA));
            end;
         end;
         mkMarkerBA:
         begin
            if UseLocator and FCorralLocator then
               NewPos := Limit(NewPos,
                               Max(RangeMinX+(MarkerB-MarkerA),Locator+OnePixel),
                               Min(DispMaxX,Max(Locator-OnePixel,0)+(MarkerB-MarkerA)))
            else
               NewPos := Limit(NewPos,RangeMinX+(MarkerB-MarkerA),DispMaxX);

            if (NewPos <> MarkerB) then
            begin
               if isGridX(X_ToPixel(NewPos-(MarkerB-MarkerA)),NewPos2) then
               begin
                  if UseLocator and FCorralLocator then
                     NewPos := Limit(NewPos + (NewPos2-(NewPos-(MarkerB-MarkerA))),
                                     Max(RangeMinX+(MarkerB-MarkerA),Locator+OnePixel),
                                     Min(DispMaxX,Max(Locator-OnePixel,0)+(MarkerB-MarkerA)))
                  else
                     NewPos := Limit(NewPos + (NewPos2-(NewPos-(MarkerB-MarkerA))),
                                     RangeMinX+(MarkerB-MarkerA),DispMaxX);

                  if (NewPos = MarkerB) then exit;
               end;
               MarkersChanged(FMarkerShift,NewPos-(MarkerB-MarkerA),NewPos);
            end;
         end;
         mkListMarker:
         begin
            HelpLocatorChanged(MinMax(NewPos,RangeMinX,RangeMaxX));
         end;
      end;
      Track;

      exit;
   end
   else
   begin
      FCanUpdate := False;

      Cursor := GetMouseCursor(Point(X,Y));

      if not Locked then
      begin
         Hint := GetHintText(Point(X,Y));
         if (Hint <> '')then
         begin
            ShowHint := FShowHints;
         end
         else
         begin
            {$IFDEF WIN32}
            Application