mmpanel.pas

一套及时通讯的原码

        2: if FMarkAColor = aValue then exit else FMarkAColor := aValue;
        3: if FMarkBColor = aValue then exit else FMarkBColor := aValue;
        4: if FGridColor = aValue then exit else FGridColor := aValue;
   end;
   Perform(CM_COLORCHANGED, 0, 0);
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetGridWidthX(aValue: Float);
begin
   if (aValue <> FGridWidthX) then
   begin
      if (aValue <= 0) then aValue := 1;
      FGridWidthX := aValue;
      Invalidate;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetGridWidthY(aValue: Float);
begin
   if (aValue <> FGridWidthY) then
   begin
      if (aValue <= 0) then aValue := 1;
      FGridWidthY := aValue;
      Invalidate;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetHelpLocator(aValue: Longint);
begin
   if (aValue <> FHelpLocator) then
   begin
      FHelpLocator := aValue;
      if (X_ToPixel(FHelpLocator) <> FLastHelpLoc) then
      begin
         DrawHelpLocator(Canvas, FLastHelpLoc);
      end;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetLocator(aValue: Longint);
begin
   if (aValue <> FLocator) then
   begin
      if FUseMarkers and FCorralLocator then
      begin
         if (FMarkerA >= 0) then aValue := Max(aValue,FMarkerA);
         if (FMarkerB >= 0) then aValue := Min(aValue,FMarkerB);
      end;
      FLocator := aValue;
      if (X_ToPixel(FLocator) <> FLastLoc) then
      begin
         DrawLocator(Canvas, FLastLoc);
      end;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetMarkerA(aValue: Longint);
begin
   if (aValue <> FMarkerA) then
   begin
      if FUseLocator and FCorralLocator and (FLocator > 0) then
         aValue := Min(aValue,FLocator-1)
      else if (FMarkerB > 0) then
         aValue := Min(aValue,FMarkerB-1);

      FMarkerA := aValue;
      if (X_ToPixel(FMarkerA) <> FLastMarkA) then
      begin
         DrawMarkerA(Canvas, FLastMarkA);
      end;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.SetMarkerB(aValue: Longint);
begin
   if (aValue <> FMarkerB) then
   begin
      if FUseLocator and FCorralLocator and (FLocator >= 0) then
         aValue := Max(aValue,FLocator+1)
      else if (FMarkerA >= 0) then
         aValue := Max(aValue,FMarkerA+1);

      FMarkerB := aValue;
      if (X_ToPixel(FMarkerB) <> FLastMarkB) then
      begin
         DrawMarkerB(Canvas, FLastMarkB);
      end;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.DrawListMarkers(aCanvas: TCanvas);
var
   i,i2,von,bis: integer;
   Loc,OldLoc,Mode: integer;

begin
   if (FMarkerList <> nil) and (FMarkerList.Count > 0) then
   with FMarkerList do
   begin
      von := LocateMarker(DispMinX-1)-2; { first marker to draw }
      bis := LocateMarker(DispMaxX);     { last marker to draw  }

      for i := von to bis do
      if inRange(i,0,Count-1) then
      begin
         if Markers[i]^.Visible then
         begin
            OldLoc := -1;
            Loc:= X_ToPixel(Markers[i]^.Offset);
            i2 := FindConnectedMarker(i);
            if (i2 >= 0) then
            begin
               if Markers[i]^.Offset < Markers[i2]^.Offset then
                  Mode := 5
               else
                  Mode := 6;
            end
            else Mode := 4;

            DrawAsSolid(aCanvas, 0, Mode, Loc, OldLoc, True, Markers[i]^.Color);
         end;
      end;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.DrawAllMarkers(aCanvas: TCanvas);
begin
   DrawListMarkers(aCanvas);

   if FUseMarkers then
   begin
      FLastMarkA := -1;
      DrawMarkerA(aCanvas, FLastMarkA);
      FLastMarkB := -1;
      DrawMarkerB(aCanvas, FLastMarkB);
   end;
   if FUseLocator then
   begin
      FLastLoc := -1;
      DrawLocator(aCanvas, FLastLoc);
   end;
   if FUseHelpLocator then
   begin
      FLastHelpLoc := -1;
      DrawHelpLocator(aCanvas, FLastHelpLoc);
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.DrawHelpLocator(aCanvas: TCanvas; var LastLoc: integer);
var
   Loc: integer;

begin
   if FUseHelpLocator then
   begin
      if (FHelpLocator >= 0) then
         Loc := X_ToPixel(FHelpLocator)
      else
         Loc := FHelpLocator;

      DrawAsXOR(aCanvas, 3, Loc, LastLoc, True, FHelpLocColor);
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.DrawLocator(aCanvas: TCanvas; var LastLoc: integer);
var
   Loc: integer;

begin
   if FUseLocator then
   begin
      if (FLocator >= 0) then
         Loc := X_ToPixel(FLocator)
      else
         Loc := FLocator;

      if FDrawSolid then
         DrawAsSolid(aCanvas, FLocatorMap.Canvas.Handle, 0, Loc, LastLoc, False, FLocColor)
      else
         DrawAsXOR(aCanvas, 0, Loc, LastLoc, False, FLocColor);
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.DrawMarkerA(aCanvas: TCanvas; var LastLoc: integer);
var
   Loc: integer;

begin
   if FUseMarkers then
   begin
      if (FMarkerA >= 0) then
          Loc := Min(X_ToPixel(FMarkerA),X_ToPixel(FMarkerB)-1)
      else
          Loc := FMarkerA;

      if FDrawSolid then
         DrawAsSolid(aCanvas,FMarkerAMap.Canvas.Handle, 1, Loc, LastLoc, False, FMarkAColor)
      else
         DrawAsXOR(aCanvas, 1, Loc, LastLoc, False, FMarkAColor);
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.DrawMarkerB(aCanvas: TCanvas; var LastLoc: integer);
var
   Loc: integer;

begin
   if FUseMarkers then
   begin
      if (FMarkerB >= 0) then
         Loc := Max(X_ToPixel(FMarkerA)+1,X_ToPixel(FMarkerB))
      else
         Loc := FMarkerB;

      if FDrawSolid then
         DrawAsSolid(aCanvas,FMarkerBMap.Canvas.Handle, 2, Loc, LastLoc, False, FMarkBColor)
      else
         DrawAsXOR(aCanvas, 2, Loc, LastLoc, False, FMarkBColor);
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.DrawMarkerGriff(aCanvas: TCanvas; Loc,Mode: integer);

   procedure SaveRectangle(X1,Y1,X2,Y2: integer);
   var
      i: integer;
   begin
      if Y2 < Y1 then SwapInt(Y1,Y2);
      with aCanvas do
      for i := 0 to (Y2-Y1)-1 do
      begin
         MoveTo(X1,Y1+i);
         LineTo(X2,Y1+i);
      end;
   end;

begin
   with aCanvas do
   begin
      case Mode of
         0: begin
               { draw Locator }
               MoveTo(Loc,BevelExtend+9);
               LineTo(Loc,Height);
               { draw griff }
               MoveTo(Loc-4,BevelExtend+5);
               LineTo(Loc+5,BevelExtend+5);
               MoveTo(Loc-3,BevelExtend+6);
               LineTo(Loc+4,BevelExtend+6);
               MoveTo(Loc-2,BevelExtend+7);
               LineTo(Loc+3,BevelExtend+7);
               MoveTo(Loc-1,BevelExtend+8);
               LineTo(Loc+2,BevelExtend+8);
            end;
         1: begin
               { draw Marker A }
               MoveTo(Loc,BevelExtend+1);
               LineTo(Loc,Height);
               { draw griff }
               MoveTo(Loc+1,BevelExtend+2);
               LineTo(Loc+2,BevelExtend+2);
               MoveTo(Loc+1,BevelExtend+3);
               LineTo(Loc+3,BevelExtend+3);
               MoveTo(Loc+1,BevelExtend+4);
               LineTo(Loc+4,BevelExtend+4);
               MoveTo(Loc+1,BevelExtend+5);
               LineTo(Loc+5,BevelExtend+5);
               MoveTo(Loc+1,BevelExtend+6);
               LineTo(Loc+4,BevelExtend+6);
               MoveTo(Loc+1,BevelExtend+7);
               LineTo(Loc+3,BevelExtend+7);
               MoveTo(Loc+1,BevelExtend+8);
               LineTo(Loc+2,BevelExtend+8);
            end;
         2: begin
               { draw Marker B }
               MoveTo(Loc,BevelExtend+1);
               LineTo(Loc,Height);
               { draw griff }
               MoveTo(Loc-1,BevelExtend+2);
               LineTo(Loc-2,BevelExtend+2);
               MoveTo(Loc-1,BevelExtend+3);
               LineTo(Loc-3,BevelExtend+3);
               MoveTo(Loc-1,BevelExtend+4);
               LineTo(Loc-4,BevelExtend+4);
               MoveTo(Loc-1,BevelExtend+5);
               LineTo(Loc-5,BevelExtend+5);
               MoveTo(Loc-1,BevelExtend+6);
               LineTo(Loc-4,BevelExtend+6);
               MoveTo(Loc-1,BevelExtend+7);
               LineTo(Loc-3,BevelExtend+7);
               MoveTo(Loc-1,BevelExtend+8);
               LineTo(Loc-2,BevelExtend+8);
            end;
   3,4,5,6: begin
               { draw List-Marker }
               MoveTo(Loc,BevelExtend+9);
               LineTo(Loc,Height);
               { draw griff }
               SaveRectangle(Loc-3,BevelExtend+2,Loc+4,BevelExtend+7);
               MoveTo(Loc-2,BevelExtend+7);
               LineTo(Loc+3,BevelExtend+7);
               MoveTo(Loc-1,BevelExtend+8);
               LineTo(Loc+2,BevelExtend+8);

               case Mode of
                 4: begin
                       Pen.Color := clBlack;
                       MoveTo(Loc-1,BevelExtend+3);
                       LineTo(Loc+2,BevelExtend+3);
                       MoveTo(Loc,BevelExtend+4);
                       LineTo(Loc,BevelExtend+7);
                    end;
                 5: begin
                       Pen.Color := clBlack;
                       MoveTo(Loc-1,BevelExtend+3);
                       LineTo(Loc+2,BevelExtend+3);
                       MoveTo(Loc-1,BevelExtend+4);
                       LineTo(Loc-1,BevelExtend+6);
                    end;
                 6: begin
                       Pen.Color := clBlack;
                       MoveTo(Loc-1,BevelExtend+3);
                       LineTo(Loc+2,BevelExtend+3);
                       MoveTo(Loc+1,BevelExtend+4);
                       LineTo(Loc+1,BevelExtend+6);
                    end;
               end;
           end;
      end;
   end;
end;

{-- TMMCustomMarkerPanel ------------------------------------------------}
procedure TMMCustomMarkerPanel.DrawAsSolid(aCanvas: TCanvas; MemDC: HDC;
                                           Mode, Loc: integer;
                                           var LastLoc: integer; Doted: Boolean;
                                           aColor: TColor);
var
   DC: HDC;

begin
   if not (csDesigning in ComponentState) and not Visible then exit;

   {$IFDEF DELPHI3}
   aCanvas.Lock;
   try
   {$ENDIF}
      aCanvas.Pen.Width := 1;
      aCanvas.Pen.Color := aColor;

      if FDrawGriff then
      begin
         aCanvas.Brush.Color := aColor;
         aCanvas.Brush.Style := bsSolid;

         IntersectClipRect(aCanvas.Handle,BevelExtend,1,Width-BevelExtend,Height);
         { clear old griff }
         if (LastLoc <> -1) and (MemDC <> 0) then
         begin
            { draw saved bitmap }
            BitBlt(aCanvas.Handle, LastLoc-5, 0, GriffWidth, Height,
                   MemDC, 0,0, SrcCopy);
         end;
         if inRange(Loc,BevelExtend,Width-BevelExtend-1) then
         begin
            { save background in bitmap and draw new griff }
            if (MemDC <> 0) then
                BitBlt(MemDC, 0, 0, GriffWidth, Height,
                       aCanvas.Handle, Loc-5,0, SrcCopy);

            DrawMarkerGriff(aCanvas,Loc,Mode);

            LastLoc := Loc;
         end
         else LastLoc := -1;
      end
      else
      begin
         if Doted then
         begin
            aCanvas.Pen.Style := psDot;
            SetBkMode(aCanvas.Handle,TRANSPARENT);
         end;
         { Reduce calls to GetHandle }
         DC := aCanvas.Handle;