mmpanel.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]               =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/index.html               =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 13.11.98 - 16:43:33 $                                        =}
{========================================================================}
unit MMPanel;

{$I COMPILER.INC}

{$DEFINE FLOATCALC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Messages,
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    ExtCtrls,
    Menus,
    MMObj,
    MMUtils,
    MMString,
    MMMath,
    MMMulDiv,
    MMMrkLst;

type
    {-- TMMPanel ---------------------------------------------------------}
    TMMPanel = class(TMMCustomPanel)
    published
       property OnClick;
       property OnDblClick;
       property OnDragDrop;
       property OnDragOver;
       property OnEndDrag;
       property OnEnter;
       property OnExit;
       property OnMouseDown;
       property OnMouseMove;
       property OnMouseUp;
       property OnResize;
       {$IFDEF WIN32}
       property OnStartDrag;
       {$ENDIF}

       property Align;
       property Alignment;
       property Bevel;
       property DragCursor;
       property DragMode;
       property Enabled;
       property Caption;
       property Color;
       property Ctl3D;
       property Font;
       property ParentColor;
       property ParentCtl3D;
       property ParentFont;
       property ParentShowHint;
       property PopupMenu;
       property ShowHint;
       property TabOrder;
       property TabStop;
       property Visible;
    end;

    {-- TMMBorder --------------------------------------------------------}
    TMMBorder = class(TMMGraphicControl)
    public
       constructor Create(AOwner: TComponent); override;
    published
       property OnClick;
       property OnDblClick;
       property OnDragDrop;
       property OnDragOver;
       property OnEndDrag;
       property OnMouseDown;
       property OnMouseMove;
       property OnMouseUp;

       property Align;
       property Bevel;
       property DragCursor;
       property DragMode;
       property Enabled;
       property Color;
       property ParentColor;
       property ParentShowHint;
       property PopupMenu;
       property ShowHint;
       property Transparent;
       property Visible;
       property Width default 185;
       property Height default 41;
    end;

type
    TMarkerShift = (mkNone, mkLocator, mkMarkerA, mkMarkerB, mkMarkerAB, mkMarkerBA,mkListMarker);
    TMarkerChangeEvent = procedure(Sender: TObject; var Value: Longint) of Object;
    TMarkersChangeEvent = procedure(Sender: TObject; Shift: TMarkerShift; var ValueA, ValueB: Longint) of Object;
    TRangeChangeEvent = procedure(Sender: TObject; Min, Max: Longint) of Object;

    {-- TMMCustomMarkerPanel --------------------------------------------}
    TMMCustomMarkerPanel = class(TMMCustomPanel)
    private
       FMarkerList    : TMMMarkerList;
       FCurMarker     : integer;
       FShowHints     : Boolean;
       FCanUpdate     : Boolean;
       FAutoScroll    : Boolean;
       FMarkerShift   : TMarkerShift;    { which mouse action }
       FGridWidthX    : Float;
       FGridWidthY    : Float;
       FSnapToGrid    : Boolean;
       FHelpLocator   : Longint;
       FLastHelpLoc   : integer;
       FLocator       : Longint;
       FLastLoc       : integer;
       FMarkerA       : Longint;
       FLastMarkA     : integer;
       FMarkerB       : Longint;
       FLastMarkB     : integer;
       FHelpLocColor  : TColor;
       FLocColor      : TColor;
       FMarkAColor    : TColor;
       FMarkBColor    : TColor;
       FGridColor     : TColor;
       FDrawSolid     : Boolean;
       FDrawGriff     : Boolean;
       FUseHelpLocator: Boolean;
       FUseLocator    : Boolean;
       FUseMarkers    : Boolean;
       FCorralLocator : Boolean;
       FRangeMinX     : Longint;
       FRangeMaxX     : Longint;
       FRangeMinY     : Longint;
       FRangeMaxY     : Longint;
       FBaseY         : Longint;
       FDispMinX      : Longint;
       FDispMaxX      : Longint;
       FDispMinY      : Longint;
       FDispMaxY      : Longint;
       FDefaultHint   : string;
       FLocked        : Boolean;

       FLButtonDown   : Boolean;
       FRButtonDown   : Boolean;
       FLocatorMap    : TBitmap;
       FMarkerAMap    : TBitmap;
       FMarkerBMap    : TBitmap;

       FSnapRange     : integer;
       FDrawGridX     : Boolean;
       FDrawGridY     : Boolean;
       FButton        : TMouseButton;
       FDragging      : Boolean;

       FOnTrackBegin  : TNotifyEvent;            { Mausaction started      }
       FOnTrack       : TNotifyEvent;            { Mausaction              }
       FOnTrackEnd    : TNotifyEvent;            { Mausaction stopped      }

       FOnHelpLocatorChanged: TMarkerChangeEvent; { help Locator changed }
       FOnLocatorChanged: TMarkerChangeEvent;  { Locator changed         }
       FOnMarkerAChanged: TMarkerChangeEvent;  { MarkerA changed         }
       FOnMarkerBChanged: TMarkerChangeEvent;  { MarkerB changed         }
       FOnMarkersChanged: TMarkersChangeEvent; { both Markers changed    }
       FOnRangeChanged  : TRangeChangeEvent;   { Range changed           }

       procedure AdjustBitmaps;
       procedure SetHelpLocator(aValue: Longint);
       procedure SetLocator(aValue: Longint);
       procedure SetMarkerA(aValue: Longint);
       procedure SetMarkerB(aValue: Longint);
       procedure SetUseHelpLocator(aValue: Boolean);
       procedure SetUseLocator(aValue: Boolean);
       procedure SetUseMarkers(aValue: Boolean);
       procedure SetColors(index: integer; aValue: TColor);
       procedure SetDrawSolid(aValue: Boolean);
       procedure SetDrawGriff(aValue : Boolean);

       procedure SetRangeMinX(aValue: Longint);
       procedure SetRangeMaxX(aValue: Longint);
       procedure SetRangeMinY(aValue: Longint);
       procedure SetRangeMaxY(aValue: Longint);
       procedure SetBaseY(aValue: Longint);

       procedure SetDispMinX(aValue: Longint);
       procedure SetDispMaxX(aValue: Longint);
       procedure SetDispMinY(aValue: Longint);
       procedure SetDispMaxY(aValue: Longint);
       procedure SetDefaultHint(aValue: String);

       procedure SetMarkerList(aList: TMMMarkerList);

       function  MouseAction(Button: TMouseButton; X: integer): TMarkerShift;

       procedure DrawHelpLocator(aCanvas: TCanvas; var LastLoc: integer);
       procedure DrawLocator(aCanvas: TCanvas; var LastLoc: integer);
       procedure DrawMarkerA(aCanvas: TCanvas; var LastLoc: integer);
       procedure DrawMarkerB(aCanvas: TCanvas; var LastLoc: integer);

       procedure DrawMarkerGriff(aCanvas: TCanvas; Loc,Mode: integer);
       procedure DrawAsSolid(aCanvas: TCanvas; MemDC: HDC; Mode,Loc: integer;
                             var LastLoc: integer; Doted: Boolean; aColor: TColor);
       procedure DrawAsXOR(aCanvas: TCanvas; Mode,Loc: integer;
                           var LastLoc: integer; Doted: Boolean; aColor: TColor);

       procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
       procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
       procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
       procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
       procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE;
       procedure CMShowHintChanged(var Message: TMessage); message CM_SHOWHINTCHANGED;
       procedure CMCursorChanged(var Message: TMessage); message CM_CURSORCHANGED;

    protected
       FOriginalCursor: TCursor;

       procedure Paint; override;
       procedure TrackBegin; dynamic;
       procedure Track; dynamic;
       procedure TrackEnd; dynamic;
       procedure HelpLocatorChanged(Value: Longint); dynamic;
       procedure LocatorChanged(Value: Longint); dynamic;
       procedure MarkerAChanged(Value: Longint); dynamic;
       procedure MarkerBChanged(Value: Longint); dynamic;
       procedure MarkersChanged(Shift: TMarkerShift; ValueA, ValueB: Longint); dynamic;
       procedure RangeChanged; dynamic;

       procedure CheckRange(var lMin, lMax: Longint; MinRange,MaxRange,MinDistance: Longint); virtual;
       function  AdjustVisibleRange(Value: Longint): Boolean; virtual;

       procedure VLineDoted(aCanvas:TCanvas;x,y1,y2:integer;Clr:TColorRef); virtual;
       procedure HLineDoted(aCanvas:TCanvas;x1,x2,y:integer;Clr:TColorRef); virtual;
       procedure DrawGridsX(aCanvas: TCanvas; min,max: Longint);virtual;
       procedure DrawGridsY(aCanvas: TCanvas; min,max: Longint);virtual;
       procedure DrawListMarkers(aCanvas: TCanvas);
       procedure DrawAllMarkers(aCanvas: TCanvas);
       procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
                           X, Y: integer); override;
       procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
       procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
                         X, Y: integer); override;
       procedure SetGridWidthX(aValue: Float); virtual;
       procedure SetDrawGridX(aValue: Boolean); virtual;
       procedure SetGridWidthY(aValue: Float); virtual;
       procedure SetDrawGridY(aValue: Boolean); virtual;

       function  GetHintText(aPos: TPoint): string; virtual;
       function  GetMouseCursor(aPos: TPoint): TCursor; virtual;

    public
       constructor Create(AOwner: TComponent); override;
       destructor  Destroy; override;

       procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;

       function  X_ToPixelNoLimit(X_Value: longint): Longint; virtual;
       function  X_ToPixel(X_Value: longint): integer; virtual;
       function  PixelTo_X(X: integer): Longint; virtual;

       function  Y_ToPixelNoLimit(Y_Value: Longint): Longint; virtual;
       function  Y_ToPixel(Y_Value: Longint): integer; virtual;
       function  PixelTo_Y(Y: integer): Longint; virtual;

       function  FindListMarker(X: integer): integer;

       function  IsAnyMarker(X: integer): Boolean;
       function  IsLocator(X: integer): Boolean;
       function  IsMarkerA(X: integer): Boolean;
       function  IsMarkerB(X: integer): Boolean;
       function  IsListMarker(X: integer): Boolean;
       function  IsGridX(X: integer; var Value: Longint): Boolean; virtual;
       function  IsGridY(Y: integer; var Value: Longint): Boolean; virtual;

       procedure SetMinMax(Min, Max: Longint); virtual;
       procedure SetMinMaxY(Min, Max: Longint); virtual;
       procedure SetRangeAll(MinX, MaxX, MinY, MaxY, YBase: Longint); virtual;
       procedure SetDispAll(MinX, MaxX, MinY, MaxY: Longint); virtual;
       property  MouseCapture;
       property  Locked: Boolean read FLocked write FLocked;

   protected
       property OnTrackBegin: TNotifyEvent read FOnTrackBegin write FOnTrackBegin;
       property OnTrack: TNotifyEvent read FOnTrack write FOnTrack;
       property OnTrackEnd: TNotifyEvent read FOnTrackEnd write FOnTrackEnd;
       property OnHelpLocatorChanged: TMarkerChangeEvent read FOnHelpLocatorChanged write FOnHelpLocatorChanged;
       property OnLocatorChanged: TMarkerChangeEvent read FOnLocatorChanged write FOnLocatorChanged;
       property OnMarkerAChanged: TMarkerChangeEvent read FOnMarkerAChanged write FOnMarkerAChanged;
       property OnMarkerBChanged: TMarkerChangeEvent read FOnMarkerBChanged write FOnMarkerBChanged;
       property OnMarkersChanged: TMarkersChangeEvent read FOnMarkersChanged write FOnMarkersChanged;
       property OnRangeChanged: TRangeChangeEvent read FOnRangeChanged write FOnRangeChanged;

       property AutoScroll: Boolean read FAutoScroll write FAutoScroll default True;
       property UseHelpLocator: Boolean read FUseHelpLocator write SetUseHelpLocator default True;
       property UseLocator: Boolean read FUseLocator write SetUseLocator default True;
       property UseMarkers: Boolean read FUseMarkers write SetUseMarkers default False;
       property CorralLocator: Boolean read FCorralLocator write FCorralLocator default True;
       property HelpLocator: Longint read FHelpLocator write SetHelpLocator default -1;
       property Locator: Longint read FLocator write SetLocator default -1;
       property MarkerA: Longint read FMarkerA write SetMarkerA default -1;
       property MarkerB: Longint read FMarkerB write SetMarkerB default -1;
       property HelpLocatorColor : TColor index 0 read FHelpLocColor write SetColors default clSilver;
       property LocatorColor : TColor index 1 read FLocColor write SetColors default clLime;
       property MarkerAColor : TColor index 2 read FMarkAColor write SetColors default clRed;
       property MarkerBColor : TColor index 3 read FMarkBColor write SetColors default clRed;
       property GridColor: TColor index 4 read FGridColor write SetColors default clGray;
       property DrawSolid: Boolean read FDrawSolid write SetDrawSolid default False;
       property DrawGriff: Boolean read FDrawGriff write SetDrawGriff default False;
       property DrawGridX: Boolean read FDrawGridX write SetDrawGridX default False;
       property DrawGridY: Boolean read FDrawGridY write SetDrawGridY default False;
       property GridWidthX: Float read FGridWidthX write SetGridWidthX;
       property GridWidthY: Float read FGridWidthY write SetGridWidthY;
       property SnapToGrid: Boolean read FSnapToGrid write FSnapToGrid default False;
       property SnapRange: integer read FSnapRange write FSnapRange default 3;
       property RangeMinX: Longint read FRangeMinX write SetRangeMinX default 0;
       property RangeMaxX: Longint read FRangeMaxX write SetRangeMaxX default 1000;
       property RangeMinY: Longint read FRangeMinY write SetRangeMinY default 0;
       property RangeMaxY: Longint read FRangeMaxY write SetRangeMaxY default 1000;
       property BaseY: Longint read FBaseY write SetBaseY default 500;
       property DispMinX: Longint read FDispMinX write SetDispMinX default 0;
       property DispMaxX: Longint read FDispMaxX write SetDispMaxX default 1000;
       property DispMinY: Longint read FDispMinY write SetDispMinY default 0;
       property DispMaxY: Longint read FDispMaxY write SetDispMaxY default 1000;
       property MarkerList: TMMMarkerList read FMarkerList write SetMarkerList;
       property DefaultHint: string read FDefaultHint write SetDefaultHint;
    end;

    {-- TMMMarkerPanel --------------------------------------------------}
    TMMMarkerPanel = class(TMMCustomMarkerPanel)
    public
       property MarkerList;
    published
       property OnClick;
       property OnDblClick;
       property OnDragDrop;
       property OnDragOver;
       property OnEndDrag;
       property OnEnter;
       property OnExit;
       property OnMouseDown;
       property OnMouseMove;
       property OnMouseUp;
       property OnResize;
       {$IFDEF WIN32}
       property OnStartDrag;
       {$ENDIF}
       property OnTrackBegin;
       property OnTrack;
       property OnTrackEnd;
       property OnHelpLocatorChanged;
       property OnLocatorChanged;
       property OnMarkerAChanged;
       property OnMarkerBChanged;
       property OnMarkersChanged;
       property OnRangeChanged;

       property Align;
       property Alignment;
       property Bevel;
       property DragCursor;
       property DragMode;
       property Enabled;
       property Color;
       property Ctl3D;
       property Font;
       property ParentFont;
       property ParentColor;
       property ParentCtl3D;
       property ParentShowHint;