开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
MMPanel.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：69k
源码类别：

Delphi控件源码

开发平台：

Delphi

MMPanel.pas：源码内容
  1. {========================================================================}
  2. {=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
  3. {========================================================================}
  4. {=                          All Rights Reserved                         =}
  5. {========================================================================}
  6. {=  D 01099 Dresden             = Fax.: +49(0)351-8037944               =}
  7. {=  Loewenstr.7a                = info@swiftsoft.de                     =}
  8. {========================================================================}
  9. {=  Actual versions on http://www.swiftsoft.de/index.html               =}
  10. {========================================================================}
  11. {=  This code is for reference purposes only and may not be copied or   =}
  12. {=  distributed in any format electronic or otherwise except one copy   =}
  13. {=  for backup purposes.                                                =}
  14. {=                                                                      =}
  15. {=  No Delphi Component Kit or Component individually or in a collection=}
  16. {=  subclassed or otherwise from the code in this unit, or associated   =}
  17. {=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
  18. {=  without express permission from SwiftSoft.                          =}
  19. {=                                                                      =}
  20. {=  For more licence informations please refer to the associated        =}
  21. {=  HelpFile.                                                           =}
  22. {========================================================================}
  23. {=  $Date: 13.11.98 - 16:43:33 $                                        =}
  24. {========================================================================}
  25. unit MMPanel;
  27. {$I COMPILER.INC}
  29. {$DEFINE FLOATCALC}
  31. interface
  33. uses
  34. {$IFDEF WIN32}
  35.     Windows,
  36. {$ELSE}
  37.     WinTypes,
  38.     WinProcs,
  39. {$ENDIF}
  40.     SysUtils,
  41.     Messages,
  42.     Classes,
  43.     Graphics,
  44.     Controls,
  45.     Forms,
  46.     Dialogs,
  47.     ExtCtrls,
  48.     Menus,
  49.     MMObj,
  50.     MMUtils,
  51.     MMString,
  52.     MMMath,
  53.     MMMulDiv,
  54.     MMMrkLst;
  56. type
  57.     {-- TMMPanel ---------------------------------------------------------}
  58.     TMMPanel = class(TMMCustomPanel)
  59.     published
  60.        property OnClick;
  61.        property OnDblClick;
  62.        property OnDragDrop;
  63.        property OnDragOver;
  64.        property OnEndDrag;
  65.        property OnEnter;
  66.        property OnExit;
  67.        property OnMouseDown;
  68.        property OnMouseMove;
  69.        property OnMouseUp;
  70.        property OnResize;
  71.        {$IFDEF WIN32}
  72.        property OnStartDrag;
  73.        {$ENDIF}
  75.        property Align;
  76.        property Alignment;
  77.        property Bevel;
  78.        property DragCursor;
  79.        property DragMode;
  80.        property Enabled;
  81.        property Caption;
  82.        property Color;
  83.        property Ctl3D;
  84.        property Font;
  85.        property ParentColor;
  86.        property ParentCtl3D;
  87.        property ParentFont;
  88.        property ParentShowHint;
  89.        property PopupMenu;
  90.        property ShowHint;
  91.        property TabOrder;
  92.        property TabStop;
  93.        property Visible;
  94.     end;
  96.     {-- TMMBorder --------------------------------------------------------}
  97.     TMMBorder = class(TMMGraphicControl)
  98.     public
  99.        constructor Create(AOwner: TComponent); override;
  100.     published
  101.        property OnClick;
  102.        property OnDblClick;
  103.        property OnDragDrop;
  104.        property OnDragOver;
  105.        property OnEndDrag;
  106.        property OnMouseDown;
  107.        property OnMouseMove;
  108.        property OnMouseUp;
  110.        property Align;
  111.        property Bevel;
  112.        property DragCursor;
  113.        property DragMode;
  114.        property Enabled;
  115.        property Color;
  116.        property ParentColor;
  117.        property ParentShowHint;
  118.        property PopupMenu;
  119.        property ShowHint;
  120.        property Transparent;
  121.        property Visible;
  122.        property Width default 185;
  123.        property Height default 41;
  124.     end;
  126. type
  127.     TMarkerShift = (mkNone, mkLocator, mkMarkerA, mkMarkerB, mkMarkerAB, mkMarkerBA,mkListMarker);
  128.     TMarkerChangeEvent = procedure(Sender: TObject; var Value: Longint) of Object;
  129.     TMarkersChangeEvent = procedure(Sender: TObject; Shift: TMarkerShift; var ValueA, ValueB: Longint) of Object;
  130.     TRangeChangeEvent = procedure(Sender: TObject; Min, Max: Longint) of Object;
  132.     {-- TMMCustomMarkerPanel --------------------------------------------}
  133.     TMMCustomMarkerPanel = class(TMMCustomPanel)
  134.     private
  135.        FMarkerList    : TMMMarkerList;
  136.        FCurMarker     : integer;
  137.        FShowHints     : Boolean;
  138.        FCanUpdate     : Boolean;
  139.        FAutoScroll    : Boolean;
  140.        FMarkerShift   : TMarkerShift;    { which mouse action }
  141.        FGridWidthX    : Float;
  142.        FGridWidthY    : Float;
  143.        FSnapToGrid    : Boolean;
  144.        FHelpLocator   : Longint;
  145.        FLastHelpLoc   : integer;
  146.        FLocator       : Longint;
  147.        FLastLoc       : integer;
  148.        FMarkerA       : Longint;
  149.        FLastMarkA     : integer;
  150.        FMarkerB       : Longint;
  151.        FLastMarkB     : integer;
  152.        FHelpLocColor  : TColor;
  153.        FLocColor      : TColor;
  154.        FMarkAColor    : TColor;
  155.        FMarkBColor    : TColor;
  156.        FGridColor     : TColor;
  157.        FDrawSolid     : Boolean;
  158.        FDrawGriff     : Boolean;
  159.        FUseHelpLocator: Boolean;
  160.        FUseLocator    : Boolean;
  161.        FUseMarkers    : Boolean;
  162.        FCorralLocator : Boolean;
  163.        FRangeMinX     : Longint;
  164.        FRangeMaxX     : Longint;
  165.        FRangeMinY     : Longint;
  166.        FRangeMaxY     : Longint;
  167.        FBaseY         : Longint;
  168.        FDispMinX      : Longint;
  169.        FDispMaxX      : Longint;
  170.        FDispMinY      : Longint;
  171.        FDispMaxY      : Longint;
  172.        FDefaultHint   : string;
  173.        FLocked        : Boolean;
  175.        FLButtonDown   : Boolean;
  176.        FRButtonDown   : Boolean;
  177.        FLocatorMap    : TBitmap;
  178.        FMarkerAMap    : TBitmap;
  179.        FMarkerBMap    : TBitmap;
  181.        FSnapRange     : integer;
  182.        FDrawGridX     : Boolean;
  183.        FDrawGridY     : Boolean;
  184.        FButton        : TMouseButton;
  185.        FDragging      : Boolean;
  187.        FOnTrackBegin  : TNotifyEvent;            { Mausaction started      }
  188.        FOnTrack       : TNotifyEvent;            { Mausaction              }
  189.        FOnTrackEnd    : TNotifyEvent;            { Mausaction stopped      }
  191.        FOnHelpLocatorChanged: TMarkerChangeEvent; { help Locator changed }
  192.        FOnLocatorChanged: TMarkerChangeEvent;  { Locator changed         }
  193.        FOnMarkerAChanged: TMarkerChangeEvent;  { MarkerA changed         }
  194.        FOnMarkerBChanged: TMarkerChangeEvent;  { MarkerB changed         }
  195.        FOnMarkersChanged: TMarkersChangeEvent; { both Markers changed    }
  196.        FOnRangeChanged  : TRangeChangeEvent;   { Range changed           }
  198.        procedure AdjustBitmaps;
  199.        procedure SetHelpLocator(aValue: Longint);
  200.        procedure SetLocator(aValue: Longint);
  201.        procedure SetMarkerA(aValue: Longint);
  202.        procedure SetMarkerB(aValue: Longint);
  203.        procedure SetUseHelpLocator(aValue: Boolean);
  204.        procedure SetUseLocator(aValue: Boolean);
  205.        procedure SetUseMarkers(aValue: Boolean);
  206.        procedure SetColors(index: integer; aValue: TColor);
  207.        procedure SetDrawSolid(aValue: Boolean);
  208.        procedure SetDrawGriff(aValue : Boolean);
  210.        procedure SetRangeMinX(aValue: Longint);
  211.        procedure SetRangeMaxX(aValue: Longint);
  212.        procedure SetRangeMinY(aValue: Longint);
  213.        procedure SetRangeMaxY(aValue: Longint);
  214.        procedure SetBaseY(aValue: Longint);
  216.        procedure SetDispMinX(aValue: Longint);
  217.        procedure SetDispMaxX(aValue: Longint);
  218.        procedure SetDispMinY(aValue: Longint);
  219.        procedure SetDispMaxY(aValue: Longint);
  220.        procedure SetDefaultHint(aValue: String);
  222.        procedure SetMarkerList(aList: TMMMarkerList);
  224.        function  MouseAction(Button: TMouseButton; X: integer): TMarkerShift;
  226.        procedure DrawHelpLocator(aCanvas: TCanvas; var LastLoc: integer);
  227.        procedure DrawLocator(aCanvas: TCanvas; var LastLoc: integer);
  228.        procedure DrawMarkerA(aCanvas: TCanvas; var LastLoc: integer);
  229.        procedure DrawMarkerB(aCanvas: TCanvas; var LastLoc: integer);
  231.        procedure DrawMarkerGriff(aCanvas: TCanvas; Loc,Mode: integer);
  232.        procedure DrawAsSolid(aCanvas: TCanvas; MemDC: HDC; Mode,Loc: integer;
  233.                              var LastLoc: integer; Doted: Boolean; aColor: TColor);
  234.        procedure DrawAsXOR(aCanvas: TCanvas; Mode,Loc: integer;
  235.                            var LastLoc: integer; Doted: Boolean; aColor: TColor);
  237.        procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  238.        procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  239.        procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
  240.        procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
  241.        procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE;
  242.        procedure CMShowHintChanged(var Message: TMessage); message CM_SHOWHINTCHANGED;
  243.        procedure CMCursorChanged(var Message: TMessage); message CM_CURSORCHANGED;
  245.     protected
  246.        FOriginalCursor: TCursor;
  248.        procedure Paint; override;
  249.        procedure TrackBegin; dynamic;
  250.        procedure Track; dynamic;
  251.        procedure TrackEnd; dynamic;
  252.        procedure HelpLocatorChanged(Value: Longint); dynamic;
  253.        procedure LocatorChanged(Value: Longint); dynamic;
  254.        procedure MarkerAChanged(Value: Longint); dynamic;
  255.        procedure MarkerBChanged(Value: Longint); dynamic;
  256.        procedure MarkersChanged(Shift: TMarkerShift; ValueA, ValueB: Longint); dynamic;
  257.        procedure RangeChanged; dynamic;
  259.        procedure CheckRange(var lMin, lMax: Longint; MinRange,MaxRange,MinDistance: Longint); virtual;
  260.        function  AdjustVisibleRange(Value: Longint): Boolean; virtual;
  262.        procedure VLineDoted(aCanvas:TCanvas;x,y1,y2:integer;Clr:TColorRef); virtual;
  263.        procedure HLineDoted(aCanvas:TCanvas;x1,x2,y:integer;Clr:TColorRef); virtual;
  264.        procedure DrawGridsX(aCanvas: TCanvas; min,max: Longint);virtual;
  265.        procedure DrawGridsY(aCanvas: TCanvas; min,max: Longint);virtual;
  266.        procedure DrawListMarkers(aCanvas: TCanvas);
  267.        procedure DrawAllMarkers(aCanvas: TCanvas);
  268.        procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  269.                            X, Y: integer); override;
  270.        procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
  271.        procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  272.                          X, Y: integer); override;
  273.        procedure SetGridWidthX(aValue: Float); virtual;
  274.        procedure SetDrawGridX(aValue: Boolean); virtual;
  275.        procedure SetGridWidthY(aValue: Float); virtual;
  276.        procedure SetDrawGridY(aValue: Boolean); virtual;
  278.        function  GetHintText(aPos: TPoint): string; virtual;
  279.        function  GetMouseCursor(aPos: TPoint): TCursor; virtual;
  281.     public
  282.        constructor Create(AOwner: TComponent); override;
  283.        destructor  Destroy; override;
  285.        procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
  287.        function  X_ToPixelNoLimit(X_Value: longint): Longint; virtual;
  288.        function  X_ToPixel(X_Value: longint): integer; virtual;
  289.        function  PixelTo_X(X: integer): Longint; virtual;
  291.        function  Y_ToPixelNoLimit(Y_Value: Longint): Longint; virtual;
  292.        function  Y_ToPixel(Y_Value: Longint): integer; virtual;
  293.        function  PixelTo_Y(Y: integer): Longint; virtual;
  295.        function  FindListMarker(X: integer): integer;
  297.        function  IsAnyMarker(X: integer): Boolean;
  298.        function  IsLocator(X: integer): Boolean;
  299.        function  IsMarkerA(X: integer): Boolean;
  300.        function  IsMarkerB(X: integer): Boolean;
  301.        function  IsListMarker(X: integer): Boolean;
  302.        function  IsGridX(X: integer; var Value: Longint): Boolean; virtual;
  303.        function  IsGridY(Y: integer; var Value: Longint): Boolean; virtual;
  305.        procedure SetMinMax(Min, Max: Longint); virtual;
  306.        procedure SetMinMaxY(Min, Max: Longint); virtual;
  307.        procedure SetRangeAll(MinX, MaxX, MinY, MaxY, YBase: Longint); virtual;
  308.        procedure SetDispAll(MinX, MaxX, MinY, MaxY: Longint); virtual;
  309.        property  MouseCapture;
  310.        property  Locked: Boolean read FLocked write FLocked;
  312.    protected
  313.        property OnTrackBegin: TNotifyEvent read FOnTrackBegin write FOnTrackBegin;
  314.        property OnTrack: TNotifyEvent read FOnTrack write FOnTrack;
  315.        property OnTrackEnd: TNotifyEvent read FOnTrackEnd write FOnTrackEnd;
  316.        property OnHelpLocatorChanged: TMarkerChangeEvent read FOnHelpLocatorChanged write FOnHelpLocatorChanged;
  317.        property OnLocatorChanged: TMarkerChangeEvent read FOnLocatorChanged write FOnLocatorChanged;
  318.        property OnMarkerAChanged: TMarkerChangeEvent read FOnMarkerAChanged write FOnMarkerAChanged;
  319.        property OnMarkerBChanged: TMarkerChangeEvent read FOnMarkerBChanged write FOnMarkerBChanged;
  320.        property OnMarkersChanged: TMarkersChangeEvent read FOnMarkersChanged write FOnMarkersChanged;
  321.        property OnRangeChanged: TRangeChangeEvent read FOnRangeChanged write FOnRangeChanged;
  323.        property AutoScroll: Boolean read FAutoScroll write FAutoScroll default True;
  324.        property UseHelpLocator: Boolean read FUseHelpLocator write SetUseHelpLocator default True;
  325.        property UseLocator: Boolean read FUseLocator write SetUseLocator default True;
  326.        property UseMarkers: Boolean read FUseMarkers write SetUseMarkers default False;
  327.        property CorralLocator: Boolean read FCorralLocator write FCorralLocator default True;
  328.        property HelpLocator: Longint read FHelpLocator write SetHelpLocator default -1;
  329.        property Locator: Longint read FLocator write SetLocator default -1;
  330.        property MarkerA: Longint read FMarkerA write SetMarkerA default -1;
  331.        property MarkerB: Longint read FMarkerB write SetMarkerB default -1;
  332.        property HelpLocatorColor : TColor index 0 read FHelpLocColor write SetColors default clSilver;
  333.        property LocatorColor : TColor index 1 read FLocColor write SetColors default clLime;
  334.        property MarkerAColor : TColor index 2 read FMarkAColor write SetColors default clRed;
  335.        property MarkerBColor : TColor index 3 read FMarkBColor write SetColors default clRed;
  336.        property GridColor: TColor index 4 read FGridColor write SetColors default clGray;
  337.        property DrawSolid: Boolean read FDrawSolid write SetDrawSolid default False;
  338.        property DrawGriff: Boolean read FDrawGriff write SetDrawGriff default False;
  339.        property DrawGridX: Boolean read FDrawGridX write SetDrawGridX default False;
  340.        property DrawGridY: Boolean read FDrawGridY write SetDrawGridY default False;
  341.        property GridWidthX: Float read FGridWidthX write SetGridWidthX;
  342.        property GridWidthY: Float read FGridWidthY write SetGridWidthY;
  343.        property SnapToGrid: Boolean read FSnapToGrid write FSnapToGrid default False;
  344.        property SnapRange: integer read FSnapRange write FSnapRange default 3;
  345.        property RangeMinX: Longint read FRangeMinX write SetRangeMinX default 0;
  346.        property RangeMaxX: Longint read FRangeMaxX write SetRangeMaxX default 1000;
  347.        property RangeMinY: Longint read FRangeMinY write SetRangeMinY default 0;
  348.        property RangeMaxY: Longint read FRangeMaxY write SetRangeMaxY default 1000;
  349.        property BaseY: Longint read FBaseY write SetBaseY default 500;
  350.        property DispMinX: Longint read FDispMinX write SetDispMinX default 0;
  351.        property DispMaxX: Longint read FDispMaxX write SetDispMaxX default 1000;
  352.        property DispMinY: Longint read FDispMinY write SetDispMinY default 0;
  353.        property DispMaxY: Longint read FDispMaxY write SetDispMaxY default 1000;
  354.        property MarkerList: TMMMarkerList read FMarkerList write SetMarkerList;
  355.        property DefaultHint: string read FDefaultHint write SetDefaultHint;
  356.     end;
  358.     {-- TMMMarkerPanel --------------------------------------------------}
  359.     TMMMarkerPanel = class(TMMCustomMarkerPanel)
  360.     public
  361.        property MarkerList;
  362.     published
  363.        property OnClick;
  364.        property OnDblClick;
  365.        property OnDragDrop;
  366.        property OnDragOver;
  367.        property OnEndDrag;
  368.        property OnEnter;
  369.        property OnExit;
  370.        property OnMouseDown;
  371.        property OnMouseMove;
  372.        property OnMouseUp;
  373.        property OnResize;
  374.        {$IFDEF WIN32}
  375.        property OnStartDrag;
  376.        {$ENDIF}
  377.        property OnTrackBegin;
  378.        property OnTrack;
  379.        property OnTrackEnd;
  380.        property OnHelpLocatorChanged;
  381.        property OnLocatorChanged;
  382.        property OnMarkerAChanged;
  383.        property OnMarkerBChanged;
  384.        property OnMarkersChanged;
  385.        property OnRangeChanged;
  387.        property Align;
  388.        property Alignment;
  389.        property Bevel;
  390.        property DragCursor;
  391.        property DragMode;
  392.        property Enabled;
  393.        property Color;
  394.        property Ctl3D;
  395.        property Font;
  396.        property ParentFont;
  397.        property ParentColor;
  398.        property ParentCtl3D;
  399.        property ParentShowHint;
  400.        property PopupMenu;
  401.        property ShowHint;
  402.        property TabOrder;
  403.        property TabStop;
  404.        property Visible;
  406.        property AutoScroll;
  407.        property CorralLocator;
  408.        property UseHelpLocator;
  409.        property UseLocator;
  410.        property UseMarkers;
  411.        property HelpLocator;
  412.        property Locator;
  413.        property GridWidthX;
  414.        property GridWidthY;
  415.        property SnapToGrid;
  416.        property SnapRange;
  417.        property MarkerA;
  418.        property MarkerB;
  419.        property LocatorColor;
  420.        property MarkerAColor;
  421.        property MarkerBColor;
  422.        property GridColor;
  423.        property DrawSolid;
  424.        property DrawGriff;
  425.        property DrawGridX;
  426.        property DrawGridY;
  427.        property RangeMinX;
  428.        property RangeMaxX;
  429.        property RangeMinY;
  430.        property RangeMaxY;
  431.        property BaseY;
  432.        property DispMinX;
  433.        property DispMaxX;
  434.        property DispMinY;
  435.        property DispMaxY;
  436.        property DefaultHint;
  437.     end;
  439. implementation
  441. const
  442.     GriffWidth = 10;
  443.     ButtonDown : Boolean = False;
  445. {== TMMBorder ============================================================}
  446. constructor TMMBorder.Create(aOwner: TComponent);
  447. begin
  448.      inherited Create(aOwner);
  450.      Width  := 185;
  451.      Height := 41;
  453.      ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
  454.      if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
  455. end;
  457. {== TMMCustomMarkerPanel ================================================}
  458. constructor TMMCustomMarkerPanel.Create(AOwner: TComponent);
  459. begin
  460.    inherited Create(AOwner);
  462.    ControlStyle   := ControlStyle - [csSetCaption,csAcceptsControls];
  464.    FMarkerList    := nil;
  466.    FMarkerAMap    := nil;
  467.    FMarkerBMap    := nil;
  468.    FLocatorMap    := nil;
  470.    FShowHints     := ShowHint;
  471.    FOriginalCursor:= Cursor;
  472.    FCanUpdate     := True;
  473.    FAutoScroll    := True;
  474.    FMarkerShift   := mkNone;
  475.    FUseHelpLocator:= True;
  476.    FUseLocator    := False;
  477.    FUseMarkers    := False;
  478.    FCorralLocator := True;
  479.    FRangeMinX     := 0;
  480.    FRangeMaxX     := 1000;
  481.    FRangeMinY     := 0;
  482.    FRangeMaxY     := 1000;
  483.    FBaseY         := 500;
  484.    FDispMinX      := 0;
  485.    FDispMaxX      := 1000;
  486.    FDispMinY      := 0;
  487.    FDispMaxY      := 1000;
  489.    FGridWidthX    := 100;
  490.    FGridWidthY    := 100;
  491.    FSnapToGrid    := False;
  492.    FSnapRange     := 3;
  494.    FHelpLocator   := -1;
  495.    FLastHelpLoc   := -1;
  496.    FHelpLocColor  := clSilver;
  498.    FLocator       := -1;
  499.    FLastLoc       := -1;
  500.    FLocColor      := clLime;
  502.    FMarkerA       := -1;
  503.    FLastMarkA     := -1;
  504.    FMarkAColor    := clRed;
  506.    FMarkerB       := -1;
  507.    FLastMarkB     := -1;
  508.    FMarkBColor    := clRed;
  510.    FGridColor     := clGray;
  511.    FDrawSolid     := False;
  512.    FDrawGriff     := False;
  513.    FDrawGridX     := False;
  514.    FDrawGridY     := False;
  515.    FDragging      := False;
  516.    UseLocator     := True;
  518.    FLocked        := False;
  519.    FDefaultHint   := '';
  521.    ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
  522.    if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
  523. end;
  525. {-- TMMCustomMarkerPanel ------------------------------------------------}
  526. destructor TMMCustomMarkerPanel.Destroy;
  527. begin
  528.    if assigned(FLocatorMap) then FLocatorMap.Free;
  529.    if assigned(FMarkerAMap) then FMarkerAMap.Free;
  530.    if assigned(FMarkerBMap) then FMarkerBMap.Free;
  532.    FMarkerList := nil;
  534.    inherited Destroy;
  535. end;
  537. {-- TMMCustomMarkerPanel ------------------------------------------------}
  538. procedure TMMCustomMarkerPanel.SetMarkerList(aList: TMMMarkerList);
  539. begin
  540.    FMarkerList := aList;
  541.    Invalidate;
  542. end;
  544. {-- TMMCustomMarkerPanel ------------------------------------------------}
  545. procedure TMMCustomMarkerPanel.SetRangeMinX(aValue: Longint);
  546. begin
  547.    SetRangeAll(aValue, FRangeMaxX, FRangeMinY, FRangeMaxY, FBaseY);
  548. end;
  550. {-- TMMCustomMarkerPanel ------------------------------------------------}
  551. procedure TMMCustomMarkerPanel.SetRangeMaxX(aValue: Longint);
  552. begin
  553.    SetRangeAll(FRangeMinX, aValue, FRangeMinY, FRangeMaxY, FBaseY);
  554. end;
  556. {-- TMMCustomMarkerPanel ------------------------------------------------}
  557. procedure TMMCustomMarkerPanel.SetRangeMinY(aValue: Longint);
  558. begin
  559.    SetRangeAll(FRangeMinX, FRangeMaxX, aValue, FRangeMaxY, FBaseY);
  560. end;
  562. {-- TMMCustomMarkerPanel ------------------------------------------------}
  563. procedure TMMCustomMarkerPanel.SetRangeMaxY(aValue: Longint);
  564. begin
  565.    SetRangeAll(FRangeMinX, FRangeMaxX, FRangeMinY, aValue, FBaseY);
  566. end;
  568. {-- TMMCustomMarkerPanel ------------------------------------------------}
  569. procedure TMMCustomMarkerPanel.SetBaseY(aValue: Longint);
  570. begin
  571.    SetRangeAll(FRangeMinX, FRangeMaxX, FRangeMinY, FRangeMaxY, aValue);
  572. end;
  574. {-- TMMCustomMarkerPanel ------------------------------------------------}
  575. procedure TMMCustomMarkerPanel.SetRangeAll(MinX, MaxX, MinY, MaxY, YBase: Longint);
  576. begin
  577.    if (MinX > MaxX) then SwapLong(MinX, MaxX);
  578.    if (MinY > MaxY) then SwapLong(MinY, MaxY);
  580.    if (MinX <> FRangeMinX) or (MaxX <> FRangeMaxX) or
  581.       (MinY <> FRangeMinY) or (MaxY <> FRangeMaxY) or
  582.       (YBase <> FBaseY) then
  583.    begin
  584.       FRangeMinX := MinX;
  585.       FRangeMaxX := Max(MaxX,MinX+1);
  586.       FRangeMinY := MinY;
  587.       FRangeMaxY := Max(MaxY,MinY+1);
  589.       FBaseY := Limit(YBase, FRangeMinY, FRangeMaxY);
  591.       SetDispAll(Limit(FDispMinX, FRangeMinX, FRangeMaxX),
  592.                  Max(Limit(FDispMaxX, FRangeMinX, FRangeMaxX),FDispMinX+1),
  593.                  Limit(FDispMinY, FRangeMinY, FRangeMaxY),
  594.                  Max(Limit(FDispMaxY, FRangeMinY, FRangeMaxY),FDispMinY+1));
  595.       Invalidate;
  596.    end;
  597.    {$IFDEF WIN32}
  598.    {$IFDEF TRIAL}
  599.    {$DEFINE _HACK1}
  600.    {$I MMHACK.INC}
  601.    {$ENDIF}
  602.     {$ENDIF}
  603. end;
  605. {-- TMMCustomMarkerPanel ------------------------------------------------}
  606. procedure TMMCustomMarkerPanel.SetDispMinX(aValue: Longint);
  607. begin
  608.    SetDispAll(aValue,FDispMaxX, FDispMinY, FDispMaxY);
  609. end;
  611. {-- TMMCustomMarkerPanel ------------------------------------------------}
  612. procedure TMMCustomMarkerPanel.SetDispMaxX(aValue: Longint);
  613. begin
  614.    SetDispAll(FDispMinX,aValue,FDispMinY,FDispMaxY);
  615. end;
  617. {-- TMMCustomMarkerPanel ------------------------------------------------}
  618. procedure TMMCustomMarkerPanel.SetDispMinY(aValue: Longint);
  619. begin
  620.    SetDispAll(FDispMinX,FDispMaxX, aValue, FDispMaxY);
  621. end;
  623. {-- TMMCustomMarkerPanel ------------------------------------------------}
  624. procedure TMMCustomMarkerPanel.SetDispMaxY(aValue: Longint);
  625. begin
  626.    SetDispAll(FDispMinX,FDispMaxX,FDispMinY,aValue);
  627. end;
  629. {-- TMMCustomMarkerPanel ------------------------------------------------}
  630. procedure TMMCustomMarkerPanel.SetMinMax(Min, Max: Longint);
  631. begin
  632.    SetDispAll(Min,Max,FDispMinY,FDispMaxY);
  633. end;
  635. {-- TMMCustomMarkerPanel ------------------------------------------------}
  636. procedure TMMCustomMarkerPanel.SetMinMaxY(Min, Max: Longint);
  637. begin
  638.    SetDispAll(FDispMinX,FDispMaxX,Min,Max);
  639. end;
  641. {-- TMMCustomMarkerPanel ------------------------------------------------}
  642. procedure TMMCustomMarkerPanel.SetDispAll(MinX, MaxX, MinY, MaxY: Longint);
  643. begin
  644.    if (MinX > MaxX) then SwapLong(MinX, MaxX);
  645.    if (MinY > MaxY) then SwapLong(MinY, MaxY);
  647.    if (MinX <> FDispMinX) or (MaxX <> FDispMaxX) or
  648.       (MinY <> FDispMinY) or (MaxY <> FDispMaxY) then
  649.    begin
  650.       CheckRange(MinX,MaxX,FRangeMinX,FRAngeMaxX,Width-2*BevelExtend);
  651.       FDispMinX := MinX;
  652.       FDispMaxX := MaxX;
  654.       CheckRange(MinY,MaxY,FRangeMinY,FRangeMaxY,Height-2*BevelExtend);
  655.       FDispMinY := MinY;
  656.       FDispMaxY := MaxY;
  658.       RangeChanged;
  659.    end;
  660.    {$IFDEF WIN32}
  661.    {$IFDEF TRIAL}
  662.    {$DEFINE _HACK2}
  663.    {$I MMHACK.INC}
  664.    {$ENDIF}
  665.    {$ENDIF}
  666. end;
  668. {-- TMMCustomMarkerPanel ------------------------------------------------}
  669. function TMMCustomMarkerPanel.AdjustVisibleRange(Value: Longint): Boolean;
  670. var
  671.    min, max: Longint;
  672.    pixel: integer;
  673.    aPos: TPoint;
  675. begin
  676.    Result := False;
  678.    { pa遲 den sichtbaren Bereich aller Elemente an (scrolling) }
  679.    if (Value >= RangeMinX) then
  680.    begin
  681.       pixel := X_ToPixel(Value);
  682.       if (pixel > Width-BevelExtend-5) and (DispMaxX < RangeMaxX) then
  683.       begin
  684.          max := limit(Value+(DispMaxX-DispMinX)div 2,RangeMinX,RangeMaxX);
  685.          min := max-(DispMaxX-DispMinX);
  686.          SetMinMax(min, max);
  688.          Update;
  690.          GetCursorPos(aPos);
  691.          aPos.X := ClientToScreen(Point(X_ToPixel(Value),0)).X;
  692.          SetCursorPos(aPos.X,aPos.Y);
  693.          Result := True;
  694.       end
  695.       else if (pixel < BevelExtend+5) and (DispMinX > RangeMinX) then
  696.       begin
  697.          min := limit(Value-(DispMaxX-DispMinX)div 2,RangeMinX,RangeMaxX);
  698.          max := min+(DispMaxX-DispMinX);
  699.          SetMinMax(min, max);
  701.          Update;
  703.          GetCursorPos(aPos);
  704.          aPos.X := ClientToScreen(Point(X_ToPixel(Value),0)).X;
  705.          SetCursorPos(aPos.X,aPos.Y);
  706.          Result := True
  707.       end;
  708.    end;
  709. end;
  711. {-- TMMCustomMarkerPanel ------------------------------------------------}
  712. procedure TMMCustomMarkerPanel.CheckRange(var lMin,lMax: Longint; MinRange,MaxRange,MinDistance: Longint);
  713. var
  714.    Diff: Longint;
  716. begin
  717.    if (lMax < lMin) then SwapLong(lMax,lMin);
  719.    lMax := Max(lMax, lMin+MinDistance);
  721.    if (lMax > MaxRange) then
  722.    begin
  723.       Diff := lMax-lMin;
  724.       lMax := MaxRange;
  725.       lMin := Max(lMax-Diff,MinRange);
  726.    end
  727.    else if (lMin < MinRange) then
  728.    begin
  729.       Diff := lMax-lMin;
  730.       lMin := MinRange;
  731.       lMax := Min(lMin+Diff,MaxRange);
  732.    end;
  733.    {$IFDEF WIN32}
  734.    {$IFDEF TRIAL}
  735.    {$DEFINE _HACK3}
  736.    {$I MMHACK.INC}
  737.    {$ENDIF}
  738.    {$ENDIF}
  739. end;
  741. {-- TMMCustomMarkerPanel ------------------------------------------------}
  742. function TMMCustomMarkerPanel.X_ToPixelNoLimit(X_Value: Longint): Longint;
  743. begin
  744. {$IFDEF FLOATCALC}
  745.    Result := BevelExtend+Round((X_Value-DispMinX)/(DispMaxX-DispMinX)*((Width-2*BevelExtend)-1));
  746. {$ELSE}
  747.    Result := BevelExtend+MulDiv32(X_Value-DispMinX,(Width-2*BevelExtend)-1,DispMaxX-DispMinX);
  748. {$ENDIF}
  749. end;
  751. {-- TMMCustomMarkerPanel ------------------------------------------------}
  752. function TMMCustomMarkerPanel.X_ToPixel(X_Value: Longint): integer;
  753. begin
  754.    Result := Limit(X_ToPixelNoLimit(X_Value),-16384,16384);
  755. end;
  757. {-- TMMCustomMarkerPanel ------------------------------------------------}
  758. function TMMCustomMarkerPanel.PixelTo_X(X: integer): Longint;
  759. begin
  760. {$IFDEF FLOATCALC}
  761.    Result := Round((X-BevelExtend)/((Width-2*BevelExtend)-1)*(DispMaxX-DispMinX))+DispMinX;
  762. {$ELSE}
  763.    Result := MulDiv32(X-BevelExtend,DispMaxX-DispMinX,(Width-2*BevelExtend)-1)+DispMinX;
  764. {$ENDIF}
  765. end;
  767. {-- TMMCustomMarkerPanel ------------------------------------------------}
  768. function TMMCustomMarkerPanel.Y_ToPixelNoLimit(Y_Value: Longint): Longint;
  769. begin
  770. {$IFDEF FLOATCALC}
  771.    Result := ((Height-BevelExtend)-1)-Round((Y_Value-DispMinY)/(DispMaxY-DispMinY)*((Height-2*BevelExtend)-1));
  772. {$ELSE}
  773.    Result := ((Height-BevelExtend)-1)-MulDiv32(Y_Value-DispMinY,(Height-2*BevelExtend)-1,DispMaxY-DispMinY);
  774. {$ENDIF}
  775. end;
  777. {-- TMMCustomMarkerPanel ------------------------------------------------}
  778. function TMMCustomMarkerPanel.Y_ToPixel(Y_Value: Longint): integer;
  779. begin
  780.    Result := Limit(Y_ToPixelNoLimit(Y_Value),-16384,16384);
  781. end;
  783. {-- TMMCustomMarkerPanel ------------------------------------------------}
  784. function TMMCustomMarkerPanel.PixelTo_Y(Y: integer): Longint;
  785. begin
  786. {$IFDEF FLOATCALC}
  787.    Result := Round((((Height-BevelExtend)-1)-Y)/((Height-2*BevelExtend)-1)*(DispMaxY-DispMinY))+DispMinY;
  788. {$ELSE}
  789.    Result := MulDiv32(((Height-BevelExtend)-1)-Y,DispMaxY-DispMinY,(Height-2*BevelExtend)-1)+DispMinY;
  790. {$ENDIF}
  791. end;
  793. {-- TMMCustomMarkerPanel ------------------------------------------------}
  794. procedure TMMCustomMarkerPanel.SetColors(Index: integer; aValue: TColor);
  795. begin
  796.    case Index of
  797.         0: if FHelpLocColor = aValue then exit else FHelpLocColor := aValue;
  798.         1: if FLocColor = aValue then exit else FLocColor := aValue;
  799.         2: if FMarkAColor = aValue then exit else FMarkAColor := aValue;
  800.         3: if FMarkBColor = aValue then exit else FMarkBColor := aValue;
  801.         4: if FGridColor = aValue then exit else FGridColor := aValue;
  802.    end;
  803.    Perform(CM_COLORCHANGED, 0, 0);
  804. end;
  806. {-- TMMCustomMarkerPanel ------------------------------------------------}
  807. procedure TMMCustomMarkerPanel.SetGridWidthX(aValue: Float);
  808. begin
  809.    if (aValue <> FGridWidthX) then
  810.    begin
  811.       if (aValue <= 0) then aValue := 1;
  812.       FGridWidthX := aValue;
  813.       Invalidate;
  814.    end;
  815. end;
  817. {-- TMMCustomMarkerPanel ------------------------------------------------}
  818. procedure TMMCustomMarkerPanel.SetGridWidthY(aValue: Float);
  819. begin
  820.    if (aValue <> FGridWidthY) then
  821.    begin
  822.       if (aValue <= 0) then aValue := 1;
  823.       FGridWidthY := aValue;
  824.       Invalidate;
  825.    end;
  826. end;
  828. {-- TMMCustomMarkerPanel ------------------------------------------------}
  829. procedure TMMCustomMarkerPanel.SetHelpLocator(aValue: Longint);
  830. begin
  831.    if (aValue <> FHelpLocator) then
  832.    begin
  833.       FHelpLocator := aValue;
  834.       if (X_ToPixel(FHelpLocator) <> FLastHelpLoc) then
  835.       begin
  836.          DrawHelpLocator(Canvas, FLastHelpLoc);
  837.       end;
  838.    end;
  839. end;
  841. {-- TMMCustomMarkerPanel ------------------------------------------------}
  842. procedure TMMCustomMarkerPanel.SetLocator(aValue: Longint);
  843. begin
  844.    if (aValue <> FLocator) then
  845.    begin
  846.       if FUseMarkers and FCorralLocator then
  847.       begin
  848.          if (FMarkerA >= 0) then aValue := Max(aValue,FMarkerA);
  849.          if (FMarkerB >= 0) then aValue := Min(aValue,FMarkerB);
  850.       end;
  851.       FLocator := aValue;
  852.       if (X_ToPixel(FLocator) <> FLastLoc) then
  853.       begin
  854.          DrawLocator(Canvas, FLastLoc);
  855.       end;
  856.    end;
  857. end;
  859. {-- TMMCustomMarkerPanel ------------------------------------------------}
  860. procedure TMMCustomMarkerPanel.SetMarkerA(aValue: Longint);
  861. begin
  862.    if (aValue <> FMarkerA) then
  863.    begin
  864.       if FUseLocator and FCorralLocator and (FLocator > 0) then
  865.          aValue := Min(aValue,FLocator-1)
  866.       else if (FMarkerB > 0) then
  867.          aValue := Min(aValue,FMarkerB-1);
  869.       FMarkerA := aValue;
  870.       if (X_ToPixel(FMarkerA) <> FLastMarkA) then
  871.       begin
  872.          DrawMarkerA(Canvas, FLastMarkA);
  873.       end;
  874.    end;
  875. end;
  877. {-- TMMCustomMarkerPanel ------------------------------------------------}
  878. procedure TMMCustomMarkerPanel.SetMarkerB(aValue: Longint);
  879. begin
  880.    if (aValue <> FMarkerB) then
  881.    begin
  882.       if FUseLocator and FCorralLocator and (FLocator >= 0) then
  883.          aValue := Max(aValue,FLocator+1)
  884.       else if (FMarkerA >= 0) then
  885.          aValue := Max(aValue,FMarkerA+1);
  887.       FMarkerB := aValue;
  888.       if (X_ToPixel(FMarkerB) <> FLastMarkB) then
  889.       begin
  890.          DrawMarkerB(Canvas, FLastMarkB);
  891.       end;
  892.    end;
  893. end;
  895. {-- TMMCustomMarkerPanel ------------------------------------------------}
  896. procedure TMMCustomMarkerPanel.DrawListMarkers(aCanvas: TCanvas);
  897. var
  898.    i,i2,von,bis: integer;
  899.    Loc,OldLoc,Mode: integer;
  901. begin
  902.    if (FMarkerList <> nil) and (FMarkerList.Count > 0) then
  903.    with FMarkerList do
  904.    begin
  905.       von := LocateMarker(DispMinX-1)-2; { first marker to draw }
  906.       bis := LocateMarker(DispMaxX);     { last marker to draw  }
  908.       for i := von to bis do
  909.       if inRange(i,0,Count-1) then
  910.       begin
  911.          if Markers[i]^.Visible then
  912.          begin
  913.             OldLoc := -1;
  914.             Loc:= X_ToPixel(Markers[i]^.Offset);
  915.             i2 := FindConnectedMarker(i);
  916.             if (i2 >= 0) then
  917.             begin
  918.                if Markers[i]^.Offset < Markers[i2]^.Offset then
  919.                   Mode := 5
  920.                else
  921.                   Mode := 6;
  922.             end
  923.             else Mode := 4;
  925.             DrawAsSolid(aCanvas, 0, Mode, Loc, OldLoc, True, Markers[i]^.Color);
  926.          end;
  927.       end;
  928.    end;
  929. end;
  931. {-- TMMCustomMarkerPanel ------------------------------------------------}
  932. procedure TMMCustomMarkerPanel.DrawAllMarkers(aCanvas: TCanvas);
  933. begin
  934.    DrawListMarkers(aCanvas);
  936.    if FUseMarkers then
  937.    begin
  938.       FLastMarkA := -1;
  939.       DrawMarkerA(aCanvas, FLastMarkA);
  940.       FLastMarkB := -1;
  941.       DrawMarkerB(aCanvas, FLastMarkB);
  942.    end;
  943.    if FUseLocator then
  944.    begin
  945.       FLastLoc := -1;
  946.       DrawLocator(aCanvas, FLastLoc);
  947.    end;
  948.    if FUseHelpLocator then
  949.    begin
  950.       FLastHelpLoc := -1;
  951.       DrawHelpLocator(aCanvas, FLastHelpLoc);
  952.    end;
  953. end;
  955. {-- TMMCustomMarkerPanel ------------------------------------------------}
  956. procedure TMMCustomMarkerPanel.DrawHelpLocator(aCanvas: TCanvas; var LastLoc: integer);
  957. var
  958.    Loc: integer;
  960. begin
  961.    if FUseHelpLocator then
  962.    begin
  963.       if (FHelpLocator >= 0) then
  964.          Loc := X_ToPixel(FHelpLocator)
  965.       else
  966.          Loc := FHelpLocator;
  968.       DrawAsXOR(aCanvas, 3, Loc, LastLoc, True, FHelpLocColor);
  969.    end;
  970. end;
  972. {-- TMMCustomMarkerPanel ------------------------------------------------}
  973. procedure TMMCustomMarkerPanel.DrawLocator(aCanvas: TCanvas; var LastLoc: integer);
  974. var
  975.    Loc: integer;
  977. begin
  978.    if FUseLocator then
  979.    begin
  980.       if (FLocator >= 0) then
  981.          Loc := X_ToPixel(FLocator)
  982.       else
  983.          Loc := FLocator;
  985.       if FDrawSolid then
  986.          DrawAsSolid(aCanvas, FLocatorMap.Canvas.Handle, 0, Loc, LastLoc, False, FLocColor)
  987.       else
  988.          DrawAsXOR(aCanvas, 0, Loc, LastLoc, False, FLocColor);
  989.    end;
  990. end;
  992. {-- TMMCustomMarkerPanel ------------------------------------------------}
  993. procedure TMMCustomMarkerPanel.DrawMarkerA(aCanvas: TCanvas; var LastLoc: integer);
  994. var
  995.    Loc: integer;
  997. begin
  998.    if FUseMarkers then
  999.    begin
  1000.       if (FMarkerA >= 0) then
  1001.           Loc := Min(X_ToPixel(FMarkerA),X_ToPixel(FMarkerB)-1)
  1002.       else
  1003.           Loc := FMarkerA;
  1005.       if FDrawSolid then
  1006.          DrawAsSolid(aCanvas,FMarkerAMap.Canvas.Handle, 1, Loc, LastLoc, False, FMarkAColor)
  1007.       else
  1008.          DrawAsXOR(aCanvas, 1, Loc, LastLoc, False, FMarkAColor);
  1009.    end;
  1010. end;
  1012. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1013. procedure TMMCustomMarkerPanel.DrawMarkerB(aCanvas: TCanvas; var LastLoc: integer);
  1014. var
  1015.    Loc: integer;
  1017. begin
  1018.    if FUseMarkers then
  1019.    begin
  1020.       if (FMarkerB >= 0) then
  1021.          Loc := Max(X_ToPixel(FMarkerA)+1,X_ToPixel(FMarkerB))
  1022.       else
  1023.          Loc := FMarkerB;
  1025.       if FDrawSolid then
  1026.          DrawAsSolid(aCanvas,FMarkerBMap.Canvas.Handle, 2, Loc, LastLoc, False, FMarkBColor)
  1027.       else
  1028.          DrawAsXOR(aCanvas, 2, Loc, LastLoc, False, FMarkBColor);
  1029.    end;
  1030. end;
  1032. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1033. procedure TMMCustomMarkerPanel.DrawMarkerGriff(aCanvas: TCanvas; Loc,Mode: integer);
  1035.    procedure SaveRectangle(X1,Y1,X2,Y2: integer);
  1036.    var
  1037.       i: integer;
  1038.    begin
  1039.       if Y2 < Y1 then SwapInt(Y1,Y2);
  1040.       with aCanvas do
  1041.       for i := 0 to (Y2-Y1)-1 do
  1042.       begin
  1043.          MoveTo(X1,Y1+i);
  1044.          LineTo(X2,Y1+i);
  1045.       end;
  1046.    end;
  1048. begin
  1049.    with aCanvas do
  1050.    begin
  1051.       case Mode of
  1052.          0: begin
  1053.                { draw Locator }
  1054.                MoveTo(Loc,BevelExtend+9);
  1055.                LineTo(Loc,Height);
  1056.                { draw griff }
  1057.                MoveTo(Loc-4,BevelExtend+5);
  1058.                LineTo(Loc+5,BevelExtend+5);
  1059.                MoveTo(Loc-3,BevelExtend+6);
  1060.                LineTo(Loc+4,BevelExtend+6);
  1061.                MoveTo(Loc-2,BevelExtend+7);
  1062.                LineTo(Loc+3,BevelExtend+7);
  1063.                MoveTo(Loc-1,BevelExtend+8);
  1064.                LineTo(Loc+2,BevelExtend+8);
  1065.             end;
  1066.          1: begin
  1067.                { draw Marker A }
  1068.                MoveTo(Loc,BevelExtend+1);
  1069.                LineTo(Loc,Height);
  1070.                { draw griff }
  1071.                MoveTo(Loc+1,BevelExtend+2);
  1072.                LineTo(Loc+2,BevelExtend+2);
  1073.                MoveTo(Loc+1,BevelExtend+3);
  1074.                LineTo(Loc+3,BevelExtend+3);
  1075.                MoveTo(Loc+1,BevelExtend+4);
  1076.                LineTo(Loc+4,BevelExtend+4);
  1077.                MoveTo(Loc+1,BevelExtend+5);
  1078.                LineTo(Loc+5,BevelExtend+5);
  1079.                MoveTo(Loc+1,BevelExtend+6);
  1080.                LineTo(Loc+4,BevelExtend+6);
  1081.                MoveTo(Loc+1,BevelExtend+7);
  1082.                LineTo(Loc+3,BevelExtend+7);
  1083.                MoveTo(Loc+1,BevelExtend+8);
  1084.                LineTo(Loc+2,BevelExtend+8);
  1085.             end;
  1086.          2: begin
  1087.                { draw Marker B }
  1088.                MoveTo(Loc,BevelExtend+1);
  1089.                LineTo(Loc,Height);
  1090.                { draw griff }
  1091.                MoveTo(Loc-1,BevelExtend+2);
  1092.                LineTo(Loc-2,BevelExtend+2);
  1093.                MoveTo(Loc-1,BevelExtend+3);
  1094.                LineTo(Loc-3,BevelExtend+3);
  1095.                MoveTo(Loc-1,BevelExtend+4);
  1096.                LineTo(Loc-4,BevelExtend+4);
  1097.                MoveTo(Loc-1,BevelExtend+5);
  1098.                LineTo(Loc-5,BevelExtend+5);
  1099.                MoveTo(Loc-1,BevelExtend+6);
  1100.                LineTo(Loc-4,BevelExtend+6);
  1101.                MoveTo(Loc-1,BevelExtend+7);
  1102.                LineTo(Loc-3,BevelExtend+7);
  1103.                MoveTo(Loc-1,BevelExtend+8);
  1104.                LineTo(Loc-2,BevelExtend+8);
  1105.             end;
  1106.    3,4,5,6: begin
  1107.                { draw List-Marker }
  1108.                MoveTo(Loc,BevelExtend+9);
  1109.                LineTo(Loc,Height);
  1110.                { draw griff }
  1111.                SaveRectangle(Loc-3,BevelExtend+2,Loc+4,BevelExtend+7);
  1112.                MoveTo(Loc-2,BevelExtend+7);
  1113.                LineTo(Loc+3,BevelExtend+7);
  1114.                MoveTo(Loc-1,BevelExtend+8);
  1115.                LineTo(Loc+2,BevelExtend+8);
  1117.                case Mode of
  1118.                  4: begin
  1119.                        Pen.Color := clBlack;
  1120.                        MoveTo(Loc-1,BevelExtend+3);
  1121.                        LineTo(Loc+2,BevelExtend+3);
  1122.                        MoveTo(Loc,BevelExtend+4);
  1123.                        LineTo(Loc,BevelExtend+7);
  1124.                     end;
  1125.                  5: begin
  1126.                        Pen.Color := clBlack;
  1127.                        MoveTo(Loc-1,BevelExtend+3);
  1128.                        LineTo(Loc+2,BevelExtend+3);
  1129.                        MoveTo(Loc-1,BevelExtend+4);
  1130.                        LineTo(Loc-1,BevelExtend+6);
  1131.                     end;
  1132.                  6: begin
  1133.                        Pen.Color := clBlack;
  1134.                        MoveTo(Loc-1,BevelExtend+3);
  1135.                        LineTo(Loc+2,BevelExtend+3);
  1136.                        MoveTo(Loc+1,BevelExtend+4);
  1137.                        LineTo(Loc+1,BevelExtend+6);
  1138.                     end;
  1139.                end;
  1140.            end;
  1141.       end;
  1142.    end;
  1143. end;
  1145. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1146. procedure TMMCustomMarkerPanel.DrawAsSolid(aCanvas: TCanvas; MemDC: HDC;
  1147.                                            Mode, Loc: integer;
  1148.                                            var LastLoc: integer; Doted: Boolean;
  1149.                                            aColor: TColor);
  1150. var
  1151.    DC: HDC;
  1153. begin
  1154.    if not (csDesigning in ComponentState) and not Visible then exit;
  1156.    {$IFDEF DELPHI3}
  1157.    aCanvas.Lock;
  1158.    try
  1159.    {$ENDIF}
  1160.       aCanvas.Pen.Width := 1;
  1161.       aCanvas.Pen.Color := aColor;
  1163.       if FDrawGriff then
  1164.       begin
  1165.          aCanvas.Brush.Color := aColor;
  1166.          aCanvas.Brush.Style := bsSolid;
  1168.          IntersectClipRect(aCanvas.Handle,BevelExtend,1,Width-BevelExtend,Height);
  1169.          { clear old griff }
  1170.          if (LastLoc <> -1) and (MemDC <> 0) then
  1171.          begin
  1172.             { draw saved bitmap }
  1173.             BitBlt(aCanvas.Handle, LastLoc-5, 0, GriffWidth, Height,
  1174.                    MemDC, 0,0, SrcCopy);
  1175.          end;
  1176.          if inRange(Loc,BevelExtend,Width-BevelExtend-1) then
  1177.          begin
  1178.             { save background in bitmap and draw new griff }
  1179.             if (MemDC <> 0) then
  1180.                 BitBlt(MemDC, 0, 0, GriffWidth, Height,
  1181.                        aCanvas.Handle, Loc-5,0, SrcCopy);
  1183.             DrawMarkerGriff(aCanvas,Loc,Mode);
  1185.             LastLoc := Loc;
  1186.          end
  1187.          else LastLoc := -1;
  1188.       end
  1189.       else
  1190.       begin
  1191.          if Doted then
  1192.          begin
  1193.             aCanvas.Pen.Style := psDot;
  1194.             SetBkMode(aCanvas.Handle,TRANSPARENT);
  1195.          end;
  1196.          { Reduce calls to GetHandle }
  1197.          DC := aCanvas.Handle;
  1198.          { clear old locator }
  1199.          if (LastLoc <> -1) and (MemDC <> 0) then
  1200.          begin
  1201.             { restore background }
  1202.             BitBlt(DC, LastLoc, 0, 1, Height,
  1203.                    MemDC, 0, 0, SrcCopy);
  1204.          end;
  1205.          if inRange(Loc,BevelExtend,Width-BevelExtend-1) then
  1206.          begin
  1207.             { save background and draw new locator }
  1208.             if (MemDC <> 0) then
  1209.                 BitBlt(MemDC, 0, 0, 1, Height,
  1210.                        DC, Loc,0, srcCopy);
  1212.             if Doted then
  1213.             begin
  1214.                VLineDoted(aCanvas,Loc,0,Height, ColorToRGB(aColor));
  1215.             end
  1216.             else
  1217.             begin
  1218.                MoveToEx(DC,Loc,0,nil);
  1219.                LineTo(DC,Loc,Height);
  1220.             end;
  1221.             LastLoc := Loc;
  1222.          end
  1223.          else LastLoc := -1;
  1225.          aCanvas.Pen.Style := psSolid;
  1226.          SetBkMode(aCanvas.Handle,OPAQUE);
  1227.       end;
  1229.    {$IFDEF DELPHI3}
  1230.    finally
  1231.       aCanvas.Unlock;
  1232.    end;
  1233.    {$ENDIF}
  1234. end;
  1236. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1237. procedure TMMCustomMarkerPanel.DrawAsXOR(aCanvas: TCanvas; Mode, Loc: integer;
  1238.                                    var LastLoc: integer; Doted: Boolean;
  1239.                                    aColor: TColor);
  1240. begin
  1241.    if not (csDesigning in ComponentState) and not Visible then exit;
  1243.    {$IFDEF DELPHI3}
  1244.    aCanvas.Lock;
  1245.    try
  1246.    {$ENDIF}
  1247.       with aCanvas do
  1248.       begin
  1249.          Pen.Width := 1;
  1250.          Pen.Mode := pmXor;
  1251.          Pen.Color := aColor;
  1252.          if FDrawGriff then
  1253.          begin
  1254.             IntersectClipRect(Canvas.Handle,BevelExtend,0,Width-BevelExtend,Height);
  1255.             { clear old griff }
  1256.             Brush.Color := aColor;
  1257.             Brush.Style := bsSolid;
  1258.             if LastLoc <> -1 then
  1259.             begin
  1260.                { delete old marker }
  1261.                DrawMarkerGriff(aCanvas,LastLoc,Mode);
  1262.             end;
  1264.             if inRange(Loc,BevelExtend,Width-BevelExtend-1) then
  1265.             begin
  1266.                { draw new marker }
  1267.                DrawMarkerGriff(aCanvas,Loc,Mode);
  1268.                LastLoc := Loc;
  1269.             end
  1270.             else LastLoc := -1;
  1271.          end
  1272.          else
  1273.          begin
  1274.             if Doted then
  1275.             begin
  1276.                Pen.Style := psDot;
  1277.                SetBkMode(Handle,TRANSPARENT);
  1278.             end;
  1280.             { alten Locator l鰏chen }
  1281.             if (LastLoc <> -1) then
  1282.             begin
  1283.                MoveTo(LastLoc, 0);
  1284.                LineTo(LastLoc, Height);
  1285.             end;
  1286.             if inRange(Loc,BevelExtend,Width-BevelExtend-1) then
  1287.             begin
  1288.                { neuen Locator zeicnen }
  1289.                MoveTo(Loc,0);
  1290.                LineTo(Loc,Height);
  1291.                LastLoc := Loc;
  1292.             end
  1293.             else LastLoc := -1;
  1294.          end;
  1295.          Pen.Mode := pmCopy;
  1296.          Pen.Style := psSolid;
  1297.          SetBkMode(Handle,OPAQUE);
  1298.       end;
  1299.    {$IFDEF DELPHI3}
  1300.    finally
  1301.       aCanvas.Unlock;
  1302.    end;
  1303.    {$ENDIF}
  1304. end;
  1306. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1307. procedure TMMCustomMarkerPanel.AdjustBitmaps;
  1308. begin
  1309.    if FDrawSolid then
  1310.    begin
  1311.       if FDrawGriff then
  1312.       begin
  1313.          if FUseLocator then
  1314.          begin
  1315.             if not assigned(FLocatorMap) then FLocatorMap := TBitmap.Create;
  1316.             FLocatorMap.Width := GriffWidth;
  1317.             FLocatorMap.Height := Height;
  1318.             FLastLoc := -1;
  1319.          end;
  1320.          if FUseMarkers then
  1321.          begin
  1322.             if not assigned(FMarkerAMap) then FMarkerAMap := TBitmap.Create;
  1323.             if not assigned(FMarkerBMap) then FMarkerBMap := TBitmap.Create;
  1324.             FMarkerAMap.Width := GriffWidth;
  1325.             FMarkerBMap.Width := GriffWidth;
  1326.             FMarkerAMap.Height := Height;
  1327.             FMarkerBMap.Height := Height;
  1328.             FLastMarkA := -1;
  1329.             FLastMarkB := -1;
  1330.          end;
  1331.       end
  1332.       else
  1333.       begin
  1334.          if FUseLocator then
  1335.          begin
  1336.             if not assigned(FLocatorMap) then FLocatorMap := TBitmap.Create;
  1337.             FLocatorMap.Width := 1;
  1338.             FLocatorMap.Height := Height;
  1339.             FLastLoc := -1;
  1340.          end;
  1341.          if FUseMarkers then
  1342.          begin
  1343.             if not assigned(FMarkerAMap) then FMarkerAMap := TBitmap.Create;
  1344.             if not assigned(FMarkerBMap) then FMarkerBMap := TBitmap.Create;
  1345.             FMarkerAMap.Width := 1;
  1346.             FMarkerBMap.Width := 1;
  1347.             FMarkerAMap.Height := Height;
  1348.             FMarkerBMap.Height := Height;
  1349.             FLastMarkA := -1;
  1350.             FLastMarkB := -1;
  1351.          end;
  1352.       end;
  1353.    end;
  1354. end;
  1356. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1357. procedure TMMCustomMarkerPanel.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
  1358. var
  1359.    H: Integer;
  1361. begin
  1362.    H := Height;
  1363.    inherited SetBounds(aLeft, aTop, aWidth, aHeight);
  1364.    if (H <> Height) and (Height > 0) then
  1365.    begin
  1366.       AdjustBitmaps;
  1367.       Invalidate;
  1368.    end;
  1369. end;
  1371. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1372. procedure TMMCustomMarkerPanel.SetDrawGriff(aValue: Boolean);
  1373. begin
  1374.    if (aValue <> FDrawGriff) then
  1375.    begin
  1376.       FDrawGriff := aValue;
  1377.       AdjustBitmaps;
  1378.       Invalidate;
  1379.    end;
  1380. end;
  1382. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1383. procedure TMMCustomMarkerPanel.SetUseHelpLocator(aValue: Boolean);
  1384. begin
  1385.    if (aValue <> FUseHelpLocator) then
  1386.    begin
  1387.       FUseHelpLocator := aValue;
  1388.       Invalidate;
  1389.    end;
  1390. end;
  1392. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1393. procedure TMMCustomMarkerPanel.SetUseLocator(aValue: Boolean);
  1394. begin
  1395.    if (aValue <> FUseLocator) then
  1396.    begin
  1397.       if assigned(FLocatorMap) then
  1398.       begin
  1399.          FLocatorMap.Free;
  1400.          FLocatorMap := nil;
  1401.       end;
  1403.       FUseLocator := aValue;
  1405.       AdjustBitmaps;
  1407.       Invalidate;
  1408.    end;
  1409. end;
  1411. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1412. procedure TMMCustomMarkerPanel.SetUseMarkers(aValue: Boolean);
  1413. begin
  1414.    if (aValue <> FUseMarkers) then
  1415.    begin
  1416.       if assigned(FMarkerAMap) then
  1417.       begin
  1418.          FMarkerAMap.Free;
  1419.          FMarkerAMap := nil;
  1420.       end;
  1421.       if assigned(FMarkerBMap) then
  1422.       begin
  1423.          FMarkerBMap.Free;
  1424.          FMarkerBMap := nil;
  1425.       end;
  1427.       FUseMarkers := aValue;
  1429.       AdjustBitmaps;
  1431.       Invalidate;
  1432.    end;
  1433. end;
  1435. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1436. procedure TMMCustomMarkerPanel.SetDrawSolid(aValue : boolean);
  1437. begin
  1438.    if aValue <> FDrawSolid then
  1439.    begin
  1440.       if assigned(FLocatorMap) then
  1441.       begin
  1442.          FLocatorMap.Free;
  1443.          FLocatorMap := nil;
  1444.       end;
  1445.       if assigned(FMarkerAMap) then
  1446.       begin
  1447.          FMarkerAMap.Free;
  1448.          FMarkerAMap := nil;
  1449.       end;
  1450.       if assigned(FMarkerBMap) then
  1451.       begin
  1452.          FMarkerBMap.Free;
  1453.          FMarkerBMap := nil;
  1454.       end;
  1456.       FDrawSolid := aValue;
  1458.       AdjustBitmaps;
  1460.       Invalidate;
  1461.    end;
  1462. end;
  1464. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1465. procedure TMMCustomMarkerPanel.SetDrawGridX(aValue: Boolean);
  1466. begin
  1467.    if (aValue <> FDrawGridX) then
  1468.    begin
  1469.       FDrawGridX := aValue;
  1470.       Invalidate;
  1471.    end;
  1472. end;
  1474. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1475. procedure TMMCustomMarkerPanel.SetDrawGridY(aValue: Boolean);
  1476. begin
  1477.    if (aValue <> FDrawGridY) then
  1478.    begin
  1479.       FDrawGridY := aValue;
  1480.       Invalidate;
  1481.    end;
  1482. end;
  1484. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1485. procedure TMMCustomMarkerPanel.TrackBegin;
  1486. begin
  1487.    if assigned(FOnTrackBegin) then
  1488.       FOnTrackBegin(self);
  1489. end;
  1491. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1492. procedure TMMCustomMarkerPanel.Track;
  1493. begin
  1494.    if assigned(FOnTrack) then
  1495.       FOnTrack(self);
  1496. end;
  1498. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1499. procedure TMMCustomMarkerPanel.TrackEnd;
  1500. begin
  1501.    if assigned(FOnTrackEnd) then
  1502.       FOnTrackEnd(self);
  1503. end;
  1505. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1506. procedure TMMCustomMarkerPanel.RangeChanged;
  1507. begin
  1508.    if not (csLoading in ComponentState) and assigned(FOnRangeChanged) then
  1509.       FOnRangeChanged(Self, FDispMinX, FDispMaxX);
  1511.    Invalidate;
  1512. end;
  1514. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1515. procedure TMMCustomMarkerPanel.HelpLocatorChanged(Value: Longint);
  1516. begin
  1517.    if FAutoScroll and (FMarkerShift = mkListMarker) then
  1518.       AdjustVisibleRange(Value);
  1520.    if assigned(FOnHelpLocatorChanged) then
  1521.       FOnHelpLocatorChanged(Self, Value);
  1523.    SetHelpLocator(Value);
  1524. end;
  1526. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1527. procedure TMMCustomMarkerPanel.LocatorChanged(Value: Longint);
  1528. begin
  1529.    if FAutoScroll then
  1530.       AdjustVisibleRange(Value);
  1532.    if assigned(FOnLocatorChanged) then
  1533.       FOnLocatorChanged(Self, Value);
  1535.    SetLocator(Value);
  1536. end;
  1538. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1539. procedure TMMCustomMarkerPanel.MarkerAChanged(Value: Longint);
  1540. begin
  1541.    if FAutoScroll then
  1542.       AdjustVisibleRange(Value);
  1544.    if assigned(FOnMarkerAChanged) then
  1545.       FOnMarkerAChanged(Self, Value);
  1547.    SetMarkerA(Value);
  1548. end;
  1550. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1551. procedure TMMCustomMarkerPanel.MarkerBChanged(Value: Longint);
  1552. begin
  1553.    if FAutoScroll then
  1554.       AdjustVisibleRange(Value);
  1556.    if assigned(FOnMarkerBChanged) then
  1557.       FOnMarkerBChanged(Self, Value);
  1559.    SetMarkerB(Value);
  1560. end;
  1562. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1563. procedure TMMCustomMarkerPanel.MarkersChanged(Shift: TMarkerShift; ValueA, ValueB: Longint);
  1564. begin
  1565.    case Shift of
  1566.      mkMarkerAB:
  1567.      begin
  1568.          if FAutoScroll then
  1569.             AdjustVisibleRange(ValueA);
  1571.          if assigned(FOnMarkersChanged) then
  1572.             FOnMarkersChanged(Self, Shift, ValueA, ValueB);
  1574.          SetMarkerB(ValueB);
  1575.          SetMarkerA(ValueA);
  1576.       end;
  1577.       mkMarkerBA:
  1578.       begin
  1579.          if FAutoScroll then
  1580.             AdjustVisibleRange(ValueB);
  1582.          if assigned(FOnMarkersChanged) then
  1583.             FOnMarkersChanged(Self, Shift, ValueA, ValueB);
  1585.          SetMarkerA(ValueA);
  1586.          SetMarkerB(ValueB);
  1587.       end;
  1588.    end;
  1589. end;
  1591. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1592. function TMMCustomMarkerPanel.IsAnyMarker(X: integer): Boolean;
  1593. begin
  1594.    Result := IsLocator(X) or IsMarkerA(X) or IsMarkerB(X) or IsListMarker(X);
  1595. end;
  1597. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1598. function TMMCustomMarkerPanel.IsLocator(X: integer): Boolean;
  1599. var
  1600.    x1: Longint;
  1601. begin
  1602.    x1 := X_ToPixel(FLocator);
  1603.    Result := FUseLocator and (FLocator >= 0) and
  1604.              (X >= x1-SNAPRANGE) and
  1605.              (X <= x1+SNAPRANGE) and
  1606.              (X >= 0) and (X <= Width);
  1607. end;
  1609. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1610. function TMMCustomMarkerPanel.IsMarkerA(X: integer): Boolean;
  1611. var
  1612.    x1: Longint;
  1613. begin
  1614.    x1 := X_ToPixel(FMarkerA);
  1615.    Result := FUseMarkers and (FMarkerA >= 0) and
  1616.              (X >= x1-SNAPRANGE-1) and
  1617.              (X <= x1+SNAPRANGE) and
  1618.              (X >= 0) and (X <= Width);
  1619. end;
  1621. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1622. function TMMCustomMarkerPanel.IsMarkerB(X: integer): Boolean;
  1623. var
  1624.    x1: Longint;
  1625. begin
  1626.    x1 := X_ToPixel(FMarkerB);
  1627.    Result := FUseMarkers and (FMarkerB >= 0) and
  1628.              (X >= x1-SNAPRANGE) and
  1629.              (X <= x1+SNAPRANGE+1) and
  1630.              (X >= 0) and (X <= Width);
  1631. end;
  1633. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1634. function TMMCustomMarkerPanel.FindListMarker(X: integer): integer;
  1635. var
  1636.    i: integer;
  1637. begin
  1638.    Result := -1;
  1639.    if (FMarkerList <> nil) and (FMarkerList.Count > 0) then
  1640.    with FMarkerList do
  1641.    begin
  1642.       i := LocateMarker(PixelTo_X(X));
  1643.       if (i < Count) and
  1644.          (X >= X_ToPixel(Markers[i]^.Offset)-SNAPRANGE) and
  1645.          (X <= X_ToPixel(Markers[i]^.Offset)+SNAPRANGE) and
  1646.           Markers[i]^.Visible then
  1647.       begin
  1648.          Result := i;
  1649.       end
  1650.       else if (i > 0) and
  1651.               (X >= X_ToPixel(Markers[i-1]^.Offset)-SNAPRANGE) and
  1652.               (X <= X_ToPixel(Markers[i-1]^.Offset)+SNAPRANGE) and
  1653.                Markers[i-1]^.Visible then
  1654.       begin
  1655.          Result := i-1;
  1656.       end;
  1657.    end;
  1658. end;
  1660. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1661. function TMMCustomMarkerPanel.IsListMarker(X: integer): Boolean;
  1662. var
  1663.    index: integer;
  1664. begin
  1665.    index := FindListMarker(X);
  1667.    Result := (index >= 0) and not FMarkerList.Markers[index]^.Fixed;
  1668. end;
  1670. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1671. function TMMCustomMarkerPanel.IsGridX(X: integer; var Value: Longint): Boolean;
  1672. var
  1673.    g: Longint;
  1675. begin
  1676.    Value := PixelTo_X(X);
  1677.    if FSnapToGrid and inMinMax(Value,DispMinX,DispMaxX) then
  1678.    begin
  1679.       g := Trunc(Trunc(Value/FGridWidthX)*FGridwidthX);
  1680.       { left }
  1681.       if (X - X_ToPixel(g) <= SNAPRANGE) then
  1682.       begin
  1683.          Result := True;
  1684.          Value := g;
  1685.          exit;
  1686.       end;
  1687.       { right }
  1688.       g := Trunc((Trunc(Value/FGridWidthX)+1)*FGridwidthX);
  1689.       if (X_ToPixel(g)-X <= SNAPRANGE) then
  1690.       begin
  1691.          Result := True;
  1692.          Value := g;
  1693.          exit;
  1694.       end;
  1695.    end;
  1696.    Result := False;
  1697. end;
  1699. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1700. function TMMCustomMarkerPanel.IsGridY(Y: integer; var Value: Longint): Boolean;
  1701. var
  1702.    g: Longint;
  1704. begin
  1705.    Value := PixelTo_Y(Y);
  1706.    if FSnapToGrid and inMinMax(Value,DispMinY,DispMaxY) then
  1707.    begin
  1708.       g := Trunc(Trunc(Value/FGridWidthY)*FGridWidthY);
  1709.       { top }
  1710.       if (Y_ToPixel(g)-Y <= SNAPRANGE) then
  1711.       begin
  1712.          Result := True;
  1713.          Value := g;
  1714.          exit;
  1715.       end;
  1716.       { bottom }
  1717.       g := Trunc((Trunc(Value/FGridWidthY)+1)*FGridwidthY);
  1718.       if (Y-Y_ToPixel(g) <= SNAPRANGE) then
  1719.       begin
  1720.          Result := True;
  1721.          Value := g;
  1722.          exit;
  1723.       end;
  1724.    end;
  1725.    Result := False;
  1726. end;
  1728. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1729. procedure TMMCustomMarkerPanel.WMLButtonDown(var Message: TWMLButtonDown);
  1730. begin
  1731.    ButtonDown   := True;
  1732.    FLButtonDown := True;
  1734.    if not FRButtonDown then inherited;
  1735. end;
  1737. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1738. procedure TMMCustomMarkerPanel.WMLButtonUp(var Message: TWMLButtonUp);
  1739. begin
  1740.    ButtonDown   := False;
  1741.    FLButtonDown := False;
  1743.    if not FRButtonDown then inherited;
  1744. end;
  1746. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1747. procedure TMMCustomMarkerPanel.WMRButtonDown(var Message: TWMRButtonDown);
  1748. begin
  1749.    ButtonDown   := True;
  1750.    FRButtonDown := True;
  1752.    if not FLButtonDown then inherited;
  1753. end;
  1755. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1756. procedure TMMCustomMarkerPanel.WMRButtonUp(var Message: TWMRButtonUp);
  1757. begin
  1758.    ButtonDown   := False;
  1759.    FRButtonDown := False;
  1761.    if not FLButtonDown then inherited;
  1762. end;
  1764. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1765. procedure TMMCustomMarkerPanel.WMCancelMode(var Message: TWMCancelMode);
  1766. var
  1767.    P: TPoint;
  1769. begin
  1770.    if FLButtonDown or FRButtonDown then
  1771.    begin
  1772.       GetCursorPos(P);
  1773.       P := ClientToScreen(P);
  1775.       if FLButtonDown then
  1776.          Perform(WM_LBUTTONUP, 0, Longint(PointToSmallPoint(P)));
  1778.       if FRButtonDown then
  1779.          Perform(WM_RBUTTONUP, 0, Longint(PointToSmallPoint(P)));
  1780.    end;
  1782.    inherited;
  1783. end;
  1785. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1786. function TMMCustomMarkerPanel.MouseAction(Button: TMouseButton; X: integer): TMarkerShift;
  1787. begin
  1788.    Result := mkNone;
  1790.    if FUseLocator and (Button = mbLeft) and IsLocator(X) then
  1791.    begin
  1792.       Result := mkLocator;
  1793.       exit;                        { Locator }
  1794.    end;
  1796.    if FUseMarkers then
  1797.    begin
  1798.       if IsMarkerA(X) then
  1799.       begin
  1800.          if (Button = mbLeft) then Result := mkMarkerA
  1801.          else Result := mkMarkerAB;
  1802.          exit;
  1803.       end;
  1805.       if IsMarkerB(X) then
  1806.       begin
  1807.          if (Button = mbLeft) then Result := mkMarkerB
  1808.          else Result := mkMarkerBA;
  1809.          exit;
  1810.       end;
  1811.    end;
  1813.    if (Button = mbLeft) and IsListMarker(X) then
  1814.    begin
  1815.       Result := mkListMarker;
  1816.       exit;                        { MarkerList }
  1817.    end;
  1818. end;
  1820. const
  1821.      inHandler: integer = 0; { verhinder Rekursion durch 2x WM_LBUTTONDOWN }
  1823. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1824. procedure TMMCustomMarkerPanel.MouseDown(Button: TMouseButton; Shift: TShiftState;
  1825.                                    X, Y: integer);
  1826. var
  1827.    P: TPoint;
  1829. begin
  1830.    if not FDragging and not FLocked then
  1831.    begin
  1832.       FMarkerShift := MouseAction(Button, X);
  1833.       if (FMarkerShift <> mkNone) then
  1834.       begin
  1835.          if (Button=mbLeft)or((Button=mbRight)and(FMarkerShift<>mkLocator)) then
  1836.          begin
  1837.             if (FMarkerShift = mkListMarker) then
  1838.                 FCurMarker := FindListMarker(X);
  1840.             MouseCapture := True;
  1841.             FButton := Button;
  1842.             FDragging := True;
  1843.             TrackBegin;
  1844.             exit;
  1845.          end;
  1846.       end
  1847.       else if (inHandler = 0) then
  1848.       begin
  1849.          inc(inHandler);
  1850.          FButton := Button;
  1851.          if (Button = mbLeft) and FUseLocator then
  1852.          begin
  1853.            { Locator neu setzen }
  1854.            if FUseMarkers and FCorralLocator then
  1855.               LocatorChanged(Limit(PixelTo_X(X),MarkerA,MarkerB))
  1856.            else
  1857.               LocatorChanged(Limit(PixelTo_X(X),DispMinX,DispMaxX));
  1858.            { !!! Trick 17 !!! }
  1859.            P := Point(X,Y);
  1860.            Perform(WM_LBUTTONUP, 0, Longint(PointToSmallPoint(P)));
  1861.            Perform(WM_MOUSEMOVE, 0, Longint(PointToSmallPoint(P)));
  1862.            Perform(WM_LBUTTONDOWN, 0, Longint(PointToSmallPoint(P)));
  1863.          end;
  1865.          dec(inHandler);
  1866.       end;
  1867.    end;
  1869.    inherited MouseDown(Button, Shift, X,Y);
  1870. end;
  1872. {-- TMMCustomMarkerPanel ------------------------------------------------}
  1873. procedure TMMCustomMarkerPanel.MouseMove(Shift: TShiftState; X,Y: integer);
  1874. var
  1875.   NewPos,NewPos2: Longint;
  1876.   OnePixel: Longint;
  1878. begin
  1879.    if FDragging and (FMarkerShift <> mkNone) then
  1880.    begin
  1881.       OnePixel := PixelTo_X(1)-PixelTo_X(0);
  1882.       isGridX(X,NewPos);
  1883.       case FMarkerShift of
  1884.          mkLocator:
  1885.          begin
  1886.             if UseMarkers and FCorralLocator then
  1887.                LocatorChanged(Limit(NewPos,MarkerA,MarkerB))
  1888.             else
  1889.                LocatorChanged(Limit(NewPos,DispMinX,DispMaxX));
  1890.          end;
  1891.          mkMarkerA:
  1892.          begin
  1893.             if UseLocator and FCorralLocator then
  1894.                NewPos := Limit(NewPos, DispMinX,Locator-OnePixel)
  1895.             else
  1896.                NewPos := Limit(NewPos, DispMinX,MarkerB-OnePixel);
  1898.             if (NewPos <> MarkerA) then
  1899.             begin
  1900.                MarkerAChanged(NewPos);
  1901.             end;
  1902.          end;
  1903.          mkMarkerB:
  1904.          begin
  1905.             if UseLocator and FCorralLocator then
  1906.                NewPos := Limit(NewPos, Locator+OnePixel,DispMaxX)
  1907.             else
  1908.                NewPos := Limit(NewPos, MarkerA+OnePixel,DispMaxX);
  1910.             if (NewPos <> MarkerB) then
  1911.             begin
  1912.                MarkerBChanged(NewPos);
  1913.             end;
  1914.          end;
  1915.          mkMarkerAB:
  1916.          begin
  1917.             if UseLocator and FCorralLocator then
  1918.                NewPos := Limit(NewPos,
  1919.                                Max(DispMinX,(Locator+OnePixel)-(MarkerB-MarkerA)),
  1920.                                Min(Locator-OnePixel,RangeMaxX-(MarkerB-MarkerA)))
  1921.             else
  1922.                NewPos := Limit(NewPos,DispMinX,RangeMaxX-(MarkerB-MarkerA));
  1924.             if (NewPos <> MarkerA) then
  1925.             begin
  1926.                if isGridX(X_ToPixel(NewPos+(MarkerB-MarkerA)),NewPos2) then
  1927.                begin
  1928.                   if UseLocator and FCorralLocator then
  1929.                      NewPos := Limit(NewPos + (NewPos2-(NewPos+(MarkerB-MarkerA))),
  1930.                                      Max(DispMinX,(Locator+OnePixel)-(MarkerB-MarkerA)),
  1931.                                      Min(Locator-OnePixel,RangeMaxX-(MarkerB-MarkerA)))
  1932.                   else
  1933.                      NewPos := Limit(NewPos + (NewPos2-(NewPos+(MarkerB-MarkerA))),
  1934.                                      DispMinX,RangeMaxX-(MarkerB-MarkerA));
  1936.                   if (NewPos = MarkerA) then exit;
  1937.                end;
  1938.                MarkersChanged(FMarkerShift,NewPos,NewPos+(MarkerB-MarkerA));
  1939.             end;
  1940.          end;
  1941.          mkMarkerBA:
  1942.          begin
  1943.             if UseLocator and FCorralLocator then
  1944.                NewPos := Limit(NewPos,
  1945.                                Max(RangeMinX+(MarkerB-MarkerA),Locator+OnePixel),
  1946.                                Min(DispMaxX,Max(Locator-OnePixel,0)+(MarkerB-MarkerA)))
  1947.             else
  1948.                NewPos := Limit(NewPos,RangeMinX+(MarkerB-MarkerA),DispMaxX);
  1950.             if (NewPos <> MarkerB) then
  1951.             begin
  1952.                if isGridX(X_ToPixel(NewPos-(MarkerB-MarkerA)),NewPos2) then
  1953.                begin
  1954.                   if UseLocator and FCorralLocator then
  1955.                      NewPos := Limit(NewPos + (NewPos2-(NewPos-(MarkerB-MarkerA))),
  1956.                                      Max(RangeMinX+(MarkerB-MarkerA),Locator+OnePixel),
  1957.                                      Min(DispMaxX,Max(Locator-OnePixel,0)+(MarkerB-MarkerA)))
  1958.                   else
  1959.                      NewPos := Limit(NewPos + (NewPos2-(NewPos-(MarkerB-MarkerA))),
  1960.                                      RangeMinX+(MarkerB-MarkerA),DispMaxX);
  1962.                   if (NewPos = MarkerB) then exit;
  1963.                end;
  1964.                MarkersChanged(FMarkerShift,NewPos-(MarkerB-MarkerA),NewPos);
  1965.             end;
  1966.          end;
  1967.          mkListMarker:
  1968.          begin
  1969.             HelpLocatorChanged(MinMax(NewPos,RangeMinX,RangeMaxX));
  1970.          end;
  1971.       end;
  1972.       Track;
  1974.       exit;
  1975.    end
  1976.    else
  1977.    begin
  1978.       FCanUpdate := False;
  1980.       Cursor := GetMouseCursor(Point(X,Y));
  1982.       if not Locked then
  1983.       begin
  1984.          Hint := GetHintText(Point(X,Y));
  1985.          if (Hint <> '')then
  1986.          begin
  1987.             ShowHint := FShowHints;
  1988.          end
  1989.          else
  1990.          begin
  1991.             {$IFDEF WIN32}
  1992.             Application.HideHint;
  1993.             {$ELSE}
  1994.             Application.CancelHint;
  1995.             {$ENDIF}
  1996.             ShowHint := False;
  1997.          end;
  1998.       end;
  2000.       FCanUpdate := True;
  2001.    end;
  2003.    inherited MouseMove(Shift,X,Y);
  2004. end;
  2006. {-- TMMCustomMarkerPanel ------------------------------------------------}
  2007. procedure TMMCustomMarkerPanel.MouseUp(Button: TMouseButton; Shift: TShiftState;
  2008.                                  X,Y: integer);
  2009. var
  2010.    NewPos: Longint;
  2011. begin
  2012.    if (Button = FButton) and FDragging then
  2013.    begin
  2014.       FDragging := False;
  2015.       if (FMarkerShift = mkListMarker) then
  2016.       begin
  2017.          if (HelpLocator >= 0) then
  2018.              NewPos := HelpLocator
  2019.          else
  2020.              NewPos := FMarkerList.Markers[FCurMarker]^.Offset;
  2022.          HelpLocatorChanged(-1);
  2023.          FMarkerList.SetOffset(FCurMarker,NewPos);
  2024.       end;
  2025.       FMarkerShift := mkNone;
  2026.       MouseCapture := False;
  2027.       TrackEnd;
  2028.    end
  2029.    else inherited MouseUp(Button,Shift,X,Y);
  2030. end;
  2032. {-- TMMCustomMarkerPanel ------------------------------------------------}
  2033. procedure TMMCustomMarkerPanel.CMShowHintChanged(var Message: TMessage);
  2034. begin
  2035.   inherited;
  2037.   if FCanUpdate then FShowHints := ShowHint;
  2038. end;
  2040. {-- TMMCustomMarkerPanel ------------------------------------------------}
  2041. procedure TMMCustomMarkerPanel.SetDefaultHint(aValue: String);
  2042. begin
  2043.   if (aValue <> FDefaultHint) then
  2044.   begin
  2045.      FDefaultHint := aValue;
  2046.      Hint := aValue;
  2047.   end;
  2048. end;
  2050. {-- TMMCustomMarkerPanel ------------------------------------------------}
  2051. function TMMCustomMarkerPanel.GetHintText(aPos: TPoint): string;
  2052. var
  2053.    i: integer;
  2054. begin
  2055.    Result := DefaultHint;
  2056.    if IsLocator(aPos.X) then Result := 'Locator'
  2057.    else if IsMarkerA(aPos.X) then Result := 'Marker A'
  2058.    else if IsMarkerB(aPos.X) then Result := 'Marker B'
  2059.    else if (FMarkerList <> nil) then
  2060.    begin
  2061.       i := FindListMarker(aPos.X);
  2062.       if (i >= 0) then Result := MarkerList.Markers[i]^.Name;
  2063.    end;
  2064. end;
  2066. {-- TMMCustomMarkerPanel ------------------------------------------------}
  2067. procedure TMMCustomMarkerPanel.CMCursorChanged(var Message: TMessage);
  2068. begin
  2069.    inherited;
  2071.    if FCanUpdate then FOriginalCursor := Cursor;
  2072. end;
  2074. {-- TMMCustomMarkerPanel ------------------------------------------------}
  2075. function TMMCustomMarkerPanel.GetMouseCursor(aPos: TPoint): TCursor;
  2076. begin
  2077.    Result := FOriginalCursor;
  2079.    if (not Locked and IsAnyMarker(aPos.X)) or
  2080.       (IsMarkerA(aPos.X) or IsMarkerB(aPos.X)) then
  2081.    begin
  2082.       if FDrawGriff then
  2083.          Result := crsHand1
  2084.       else
  2085.          Result := crsMark1
  2086.    end;
  2087. end;
  2089. {-- TMMCustomMarkerPanel ------------------------------------------------}
  2090. procedure TMMCustomMarkerPanel.VLineDoted(aCanvas:TCanvas;x,y1,y2:integer;Clr:TColorRef);
  2091. var
  2092.    DC: HDC;
  2093. begin
  2094.    DC := aCanvas.Handle;
  2095.    if (y1 > y2) then SwapInt(y1,y2);
  2096.    while y1 < y2 do
  2097.    begin
  2098.       SetPixel(DC,x,y1,Clr);
  2099.       inc(y1,3);
  2100.    end;
  2101. end;
  2103. {-- TMMCustomMarkerPanel ------------------------------------------------}
  2104. procedure TMMCustomMarkerPanel.HLineDoted(aCanvas:TCanvas;x1,x2,y:integer;Clr:TColorRef);
  2105. var
  2106.    DC: HDC;
  2107. begin
  2108.    DC := aCanvas.Handle;
  2109.    if (x1 > x2) then SwapInt(x1,x2);
  2110.    while x1 < x2 do
  2111.    begin
  2112.       SetPixel(DC,x1,y,Clr);
  2113.       inc(x1,3);
  2114.    end;
  2115. end;
  2117. {-- TMMCustomMarkerPanel ------------------------------------------------}
  2118. procedure TMMCustomMarkerPanel.DrawGridsX(aCanvas: TCanvas; min,max: Longint);
  2119. var
  2120.    i,x1,y1,y2,Steps: integer;
  2121.    Offset: Longint;
  2122.    Clr: TColorRef;
  2124. begin
  2125.    if FDrawGridX then
  2126.    begin
  2127.       Steps := Trunc((DispMaxX-DispMinX)/GridWidthX);
  2128.       Offset := Round(DispMinX+GridWidthX-ModR(DispMinX,GridWidthX));
  2130.       if (Steps > Width div 2) then exit;
  2132.       Clr := ColorToRGB(FGridColor);
  2134.       y1 := Y_ToPixel(DispMinY);
  2135.       y2 := Y_ToPixel(DispMaxY);
  2137.       for i := 0 to Steps do
  2138.       begin
  2139.          x1 := X_ToPixel(Offset+Trunc(i*GridWidthX));
  2141.          if (x1 >= X_ToPixel(max)) then break;
  2143.          if (x1 >= X_ToPixel(min)) then
  2144.             VLineDoted(aCanvas,x1,y1,y2,Clr);
  2145.       end;
  2146.    end;
  2147. end;
  2149. {-- TMMCustomMarkerPanel ------------------------------------------------}
  2150. procedure TMMCustomMarkerPanel.DrawGridsY(aCanvas: TCanvas; min,max: Longint);
  2151. var
  2152.    i,x1,x2,y1,Steps: integer;
  2153.    Offset: Longint;
  2154.    Clr: TColorRef;
  2156. begin
  2157.    if FDrawGridY then
  2158.    begin
  2159.       Steps := Trunc((DispMaxY-DispMinY)/GridWidthY);
  2160.       Offset := Round(DispMinY+GridWidthY-ModR(DispMinY,GridWidthY));
  2162.       if (Steps > Height div 2) then exit;
  2164.       x1 := X_ToPixel(DispMinX);
  2165.       x2 := X_ToPixel(DispMaxX);
  2167.       Clr := ColorToRGB(FGridColor);
  2169.       for i := 0 To Steps do
  2170.       begin
  2171.          y1 := Height-1-Y_ToPixel(Offset+Trunc(i*GridWidthY));
  2173.          if (y1 >= Y_ToPixel(min)) then break;
  2175.          if (y1 >= Y_ToPixel(max)) then
  2176.             HLineDoted(aCanvas,x1,x2,y1,Clr);
  2177.       end;
  2178.    end;
  2179. end;
  2181. {-- TMMCustomMarkerPanel ------------------------------------------------}
  2182. procedure TMMCustomMarkerPanel.Paint;
  2183. begin
  2184.    inherited Paint;
  2186.    DrawGridsX(Canvas,DispMinX,DispMaxX);
  2187.    DrawGridsY(Canvas,DispMinY,DispMaxY);
  2189.    DrawAllMarkers(Canvas);
  2190. end;
  2192. end.