mmpanel.pas

一套及时通讯的原码

         { clear old locator }
         if (LastLoc <> -1) and (MemDC <> 0) then
         begin
            { restore background }
            BitBlt(DC, LastLoc, 0, 1, Height,
                   MemDC, 0, 0, SrcCopy);
         end;
         if inRange(Loc,BevelExtend,Width-BevelExtend-1) then
         begin
            { save background and draw new locator }
            if (MemDC <> 0) then
                BitBlt(MemDC, 0, 0, 1, Height,
                       DC, Loc,0, srcCopy);

            if Doted then
            begin
               VLineDoted(aCanvas,Loc,0,Height, ColorToRGB(aColor));
            end
            else
            begin
               MoveToEx(DC,Loc,0,nil);
               LineTo(DC,Loc,Height);
            end;
            LastLoc := Loc;
         end
         else LastLoc := -1;

         aCanvas.Pen.Style := psSolid;
         SetBkMode(aCanvas.Handle,OPAQUE);
      end;

   {$IFDEF DELPHI3}
   finally
      aCanvas.Unlock;
   end;
   {$ENDIF}
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.DrawAsXOR(aCanvas: TCanvas; Mode, Loc: integer;
                                   var LastLoc: integer; Doted: Boolean;
                                   aColor: TColor);
begin
   if not (csDesigning in ComponentState) and not Visible then exit;

   {$IFDEF DELPHI3}
   aCanvas.Lock;
   try
   {$ENDIF}
      with aCanvas do
      begin
         Pen.Width := 1;
         Pen.Mode := pmXor;
         Pen.Color := aColor;
         if FDrawGriff then
         begin
            IntersectClipRect(Canvas.Handle,BevelExtend,0,Width-BevelExtend,Height);
            { clear old griff }
            Brush.Color := aColor;
            Brush.Style := bsSolid;
            if LastLoc <> -1 then
            begin
               { delete old marker }
               DrawMarkerGriff(aCanvas,LastLoc,Mode);
            end;

            if inRange(Loc,BevelExtend,Width-BevelExtend-1) then
            begin
               { draw new marker }
               DrawMarkerGriff(aCanvas,Loc,Mode);
               LastLoc := Loc;
            end
            else LastLoc := -1;
         end
         else
         begin
            if Doted then
            begin
               Pen.Style := psDot;
               SetBkMode(Handle,TRANSPARENT);
            end;

            { alten Locator l鰏chen }
            if (LastLoc <> -1) then
            begin
               MoveTo(LastLoc, 0);
               LineTo(LastLoc, Height);
            end;
            if inRange(Loc,BevelExtend,Width-BevelExtend-1) then
            begin
               { neuen Locator zeicnen }
               MoveTo(Loc,0);
               LineTo(Loc,Height);
               LastLoc := Loc;
            end
            else LastLoc := -1;
         end;
         Pen.Mode := pmCopy;
         Pen.Style := psSolid;
         SetBkMode(Handle,OPAQUE);
      end;
   {$IFDEF DELPHI3}
   finally
      aCanvas.Unlock;
   end;
   {$ENDIF}
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.AdjustBitmaps;
begin
   if FDrawSolid then
   begin
      if FDrawGriff then
      begin
         if FUseLocator then
         begin
            if not assigned(FLocatorMap) then FLocatorMap := TBitmap.Create;
            FLocatorMap.Width := GriffWidth;
            FLocatorMap.Height := Height;
            FLastLoc := -1;
         end;
         if FUseMarkers then
         begin
            if not assigned(FMarkerAMap) then FMarkerAMap := TBitmap.Create;
            if not assigned(FMarkerBMap) then FMarkerBMap := TBitmap.Create;
            FMarkerAMap.Width := GriffWidth;
            FMarkerBMap.Width := GriffWidth;
            FMarkerAMap.Height := Height;
            FMarkerBMap.Height := Height;
            FLastMarkA := -1;
            FLastMarkB := -1;
         end;
      end
      else
      begin
         if FUseLocator then
         begin
            if not assigned(FLocatorMap) then FLocatorMap := TBitmap.Create;
            FLocatorMap.Width := 1;
            FLocatorMap.Height := Height;
            FLastLoc := -1;
         end;
         if FUseMarkers then
         begin
            if not assigned(FMarkerAMap) then FMarkerAMap := TBitmap.Create;
            if not assigned(FMarkerBMap) then FMarkerBMap := TBitmap.Create;
            FMarkerAMap.Width := 1;
            FMarkerBMap.Width := 1;
            FMarkerAMap.Height := Height;
            FMarkerBMap.Height := Height;
            FLastMarkA := -1;
            FLastMarkB := -1;
         end;
      end;
   end;
end;

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

begin
   H := Height;
   inherited SetBounds(aLeft, aTop, aWidth, aHeight);
   if (H <> Height) and (Height > 0) then
   begin
      AdjustBitmaps;
      Invalidate;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetDrawGriff(aValue: Boolean);
begin
   if (aValue <> FDrawGriff) then
   begin
      FDrawGriff := aValue;
      AdjustBitmaps;
      Invalidate;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetUseHelpLocator(aValue: Boolean);
begin
   if (aValue <> FUseHelpLocator) then
   begin
      FUseHelpLocator := aValue;
      Invalidate;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetUseLocator(aValue: Boolean);
begin
   if (aValue <> FUseLocator) then
   begin
      if assigned(FLocatorMap) then
      begin
         FLocatorMap.Free;
         FLocatorMap := nil;
      end;

      FUseLocator := aValue;

      AdjustBitmaps;

      Invalidate;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetUseMarkers(aValue: Boolean);
begin
   if (aValue <> FUseMarkers) then
   begin
      if assigned(FMarkerAMap) then
      begin
         FMarkerAMap.Free;
         FMarkerAMap := nil;
      end;
      if assigned(FMarkerBMap) then
      begin
         FMarkerBMap.Free;
         FMarkerBMap := nil;
      end;

      FUseMarkers := aValue;

      AdjustBitmaps;

      Invalidate;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetDrawSolid(aValue : boolean);
begin
   if aValue <> FDrawSolid then
   begin
      if assigned(FLocatorMap) then
      begin
         FLocatorMap.Free;
         FLocatorMap := nil;
      end;
      if assigned(FMarkerAMap) then
      begin
         FMarkerAMap.Free;
         FMarkerAMap := nil;
      end;
      if assigned(FMarkerBMap) then
      begin
         FMarkerBMap.Free;
         FMarkerBMap := nil;
      end;

      FDrawSolid := aValue;

      AdjustBitmaps;

      Invalidate;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetDrawGridX(aValue: Boolean);
begin
   if (aValue <> FDrawGridX) then
   begin
      FDrawGridX := aValue;
      Invalidate;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetDrawGridY(aValue: Boolean);
begin
   if (aValue <> FDrawGridY) then
   begin
      FDrawGridY := aValue;
      Invalidate;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.TrackBegin;
begin
   if assigned(FOnTrackBegin) then
      FOnTrackBegin(self);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.Track;
begin
   if assigned(FOnTrack) then
      FOnTrack(self);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.TrackEnd;
begin
   if assigned(FOnTrackEnd) then
      FOnTrackEnd(self);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.RangeChanged;
begin
   if not (csLoading in ComponentState) and assigned(FOnRangeChanged) then
      FOnRangeChanged(Self, FDispMinX, FDispMaxX);

   Invalidate;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.HelpLocatorChanged(Value: Longint);
begin
   if FAutoScroll and (FMarkerShift = mkListMarker) then
      AdjustVisibleRange(Value);

   if assigned(FOnHelpLocatorChanged) then
      FOnHelpLocatorChanged(Self, Value);

   SetHelpLocator(Value);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.LocatorChanged(Value: Longint);
begin
   if FAutoScroll then
      AdjustVisibleRange(Value);

   if assigned(FOnLocatorChanged) then
      FOnLocatorChanged(Self, Value);

   SetLocator(Value);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.MarkerAChanged(Value: Longint);
begin
   if FAutoScroll then
      AdjustVisibleRange(Value);

   if assigned(FOnMarkerAChanged) then
      FOnMarkerAChanged(Self, Value);

   SetMarkerA(Value);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.MarkerBChanged(Value: Longint);
begin
   if FAutoScroll then
      AdjustVisibleRange(Value);

   if assigned(FOnMarkerBChanged) then
      FOnMarkerBChanged(Self, Value);

   SetMarkerB(Value);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.MarkersChanged(Shift: TMarkerShift; ValueA, ValueB: Longint);
begin
   case Shift of
     mkMarkerAB:
     begin
         if FAutoScroll then
            AdjustVisibleRange(ValueA);

         if assigned(FOnMarkersChanged) then
            FOnMarkersChanged(Self, Shift, ValueA, ValueB);

         SetMarkerB(ValueB);
         SetMarkerA(ValueA);
      end;
      mkMarkerBA:
      begin
         if FAutoScroll then
            AdjustVisibleRange(ValueB);

         if assigned(FOnMarkersChanged) then
            FOnMarkersChanged(Self, Shift, ValueA, ValueB);

         SetMarkerA(ValueA);
         SetMarkerB(ValueB);
      end;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
function TMMCustomMarkerPanel.IsAnyMarker(X: integer): Boolean;
begin
   Result := IsLocator(X) or IsMarkerA(X) or IsMarkerB(X) or IsListMarker(X);
end;