rm_ctrls.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 968 行 · 第 1/2 页

    procedure ColorButtonClick(Sender: TObject);
    procedure DrawButtonGlyph(aColor: TColor);

    procedure SetSelectedColor(const Value: TColor);
    procedure SetColorType(const Value: TRMColorType);
    function GetCustomColors: TStrings;
    procedure SetCustomColors(const Value: TStrings);
  protected
    function GetDropDownPanel: TRMPopupWindow; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property TopMargin: integer read FTopMargin write FTopMargin;
    property BottomMargin: integer read FBottomMargin write FBottomMargin;
    property HoriMargin: integer read FHoriMargin write FHoriMargin;
    property DragBarHeight: integer read FDragBarHeight write FDragBarHeight;
    property DragBarSpace: integer read FDragBarSpace write FDragBarSpace;
    property ColorSpace: integer read FColorSpace write FColorSpace;
    property ColorSpaceTop: integer read FColorSpaceTop write FColorSpaceTop;
    property ColorSpaceBottom: integer read FColorSpaceBottom write FColorSpaceBottom;
    property ColorSize: integer read FColorSize write FColorSize;
    property ButtonHeight: integer read FButtonHeight write FButtonHeight;

    property AutoCaption: string read FAutoCaption write FAutoCaption;
    property CurrentColor: TColor read FCurrentColor write SetSelectedColor;
    property ColorType: TRMColorType read FColorType write SetColorType;
    property CustomColors: TStrings read GetCustomColors write SetCustomColors;

    property OnColorChange: TNotifyEvent read FOnColorChange write FOnColorChange;
  end;

  TRMRulerOrientationType = (roHorizontal, roVertical);

  {@TRMDesignerRuler }
  TRMDesignerRuler = class(TPaintBox) //TGraphicControl)
  private
    FDrawRect: TRect;
    FGuide1X: Integer;
    FGuide1Y: Integer;
    FGuide2X: Integer;
    FGuide2Y: Integer;
    FGuideHeight: Integer;
    FGuideWidth: Integer;
    FHalfTicks: Boolean;
    FMargin: Integer;
    FOrientation: TRMRulerOrientationType;
    FPixelIncrement: Double;
    FScrollOffset: Integer;
    FThickness: Integer;
    FTicksPerUnit: Integer;
    FTickFactor: Single;
    FUnits: TRMUnitType;
    FScale: Double;

    procedure DrawGuide(aGuideX, aGuideY: Integer);
    procedure InitGuides;
    procedure PaintRuler;
    procedure SetOrientation(aOrientation: TRMRulerOrientationType);
    procedure SetUnits(aUnit: TRMUnitType);
    procedure SetScrollOffset(Value: Integer);
    function UpdateGuidePosition(aNewPosition: Integer; var aGuideX, aGuideY: Integer): Boolean;
    procedure ChangeUnits(aUnit: TRMUnitType);
  protected
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    procedure Scroll(Value: Integer);
    procedure SetGuides(aPosition1, aPosition2: Integer);
    property Orientation: TRMRulerOrientationType read FOrientation write SetOrientation;
    property Units: TRMUnitType read FUnits write SetUnits;
    property ScrollOffset: Integer read FScrollOffset write SetScrollOffset;
    property PixelIncrement: Double read FPixelIncrement;
    property Scale: Double read FScale write FScale;
  end;

  TRMScrollBarKind = (rmsbHorizontal, rmsbVertical);
  TRMScrollEvent = procedure(Sender: TObject; Kind: TRMScrollBarKind) of object;

  TRMScrollBox = class;

  { TRMScrollBar }
  TRMScrollBar = class(TPersistent)
  private
    FControl: TRMScrollBox;
    FKind: TRMScrollBarKind;
    FMin: integer;
    FMax: integer;
    FPage: integer;
    FPosition: integer;
    FTrackPos: integer;
    FLargeChange: integer;
    FSmallChange: integer;
    FThumbValue: integer;
    FVisible: Boolean;
    FScrollInfo: TScrollInfo;

    procedure SetMin(Value: integer);
    procedure SetMax(Value: integer);
    procedure SetSmallChange(Value: integer);
    procedure SetLargeChange(Value: integer);
    procedure SetPage(Value: integer);
    procedure SetPosition(Value: integer);
    function GetTrackPos: integer;
    procedure SetScrollData(Value: integer; Mask: Cardinal; MinMax: Boolean);
    function GetScrollData(Mask: Cardinal): integer;
    procedure ScrollMessage(var Msg: TWMScroll);
    constructor Create(AControl: TRMScrollBox; AKind: TRMScrollBarKind);
    procedure SetVisible(Value: Boolean);
    function GetBarKind: Word;
  protected
  public
    procedure Assign(Source: TPersistent); override;

    procedure RefreshLargePage(Value: Integer);
    property Kind: TRMScrollBarKind read FKind;
    property TrackPos: integer read GetTrackPos;
  published
    property Min: integer read FMin write SetMin;
    property Max: integer read FMax write SetMax;
    property SmallChange: integer read FSmallChange write SetSmallChange;
    property LargeChange: integer read FLargeChange write SetLargeChange;
    property Position: integer read FPosition write SetPosition;
    property ThumbValue: integer read FThumbValue write FThumbValue;
    property Visible: Boolean read FVisible write SetVisible;
  end;

  { TRMScrollBox }
  TRMScrollBox = class(TWinControl)
  private
    FBorderStyle: TBorderStyle;
    FHorzScrollBar: TRMScrollBar;
    FVertScrollBar: TRMScrollBar;
    FOnResize: TNotifyEvent;
    FOnChange: TRMScrollEvent;
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVSCroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMNCHitTest(var Message: TMessage); message WM_NCHITTEST;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure SetHorzScrollBar(Value: TRMScrollBar);
    procedure SetVertScrollBar(Value: TRMScrollBar);
    procedure SetBorderStyle(Value: TBorderStyle);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Align;
    property HorzScrollBar: TRMScrollBar read FHorzScrollBar write SetHorzScrollBar;
    property VertScrollBar: TRMScrollBar read FVertScrollBar write SetVertScrollBar;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property Color;
    property Ctl3D;
    property Font;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;
    property OnChange: TRMScrollEvent read FOnChange write FOnChange;
  end;

function RMNewLine: TRMSeparatorMenuItem;
function RMNewItem(const ACaption: string; AShortCut: TShortCut;
  AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: THelpContext;
  const AName: string; ATag: integer = 0): TRMMenuItem;

implementation

uses RM_Utils, RM_Const, RM_Const1, RM_Class;

const
  sSpinUpBtn = 'RM_MYSPINUP';
  sSpinDownBtn = 'RM_MYSPINDOWN';
  cDropdownComboWidth = 11;

const
  InitRepeatPause = 400; { pause before repeat timer (ms) }
  RepeatPause = 100;

function RMNewLine: TRMSeparatorMenuItem;
begin
  Result := TRMSeparatorMenuItem.Create(Application);
end;

function RMNewItem(const ACaption: string; AShortCut: TShortCut;
  AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: THelpContext;
  const AName: string; ATag: integer = 0): TRMMenuItem;
begin
  Result := TRMMenuItem.Create(Application);
  with Result do
  begin
    Caption := ACaption;
    ShortCut := AShortCut;
    OnClick := AOnClick;
    HelpContext := hCtx;
    Checked := AChecked;
    Enabled := AEnabled;
    //    Name := AName;
    Tag := ATag;
  end;
end;

{------------------------------------------------------------------------------}
{TRMEdit}

procedure TRMEdit.SetAddTo(Value: TRMToolBar);
begin
{$IFDEF USE_TB2k}
  Value.Items.Add(self);
{$ELSE}
  if Parent <> Value then
    Parent := Value;
{$ENDIF}
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMToolbarSep}

procedure TRMToolbarSep.SetAddTo(Value: TRMToolBar);
begin
{$IFDEF USE_TB2k}
  Value.Items.Add(self);
{$ELSE}
  if Parent <> Value then
    Parent := Value;
{$ENDIF}
end;

{------------------------------------------------------------------------------}

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{$IFDEF USE_TB2k}

function TRMToolbar.GetDockedto: TRMDock;
begin
  Result := CurrentDock;
end;

procedure TRMToolbar.SetDockedto(Value: TRMDock);
begin
  CurrentDock := Value;
end;
{$ENDIF}

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMToolbarButton}

procedure TRMToolbarButton.SetAddTo(Value: TRMToolBar);
begin
{$IFDEF USE_TB2k}
  Value.Items.Add(self);
{$ELSE}
  if Parent <> Value then
    Parent := Value;
{$ENDIF}
end;

{$IFDEF USE_TB2k}

function TRMToolbarButton.GetDown: Boolean;
begin
  Result := Checked;
end;

procedure TRMToolbarButton.SetDown(Value: Boolean);
begin
  Checked := Value;
end;

function TRMToolbarButton.GetAllowAllUp: Boolean;
begin
  Result := AutoCheck;
end;

procedure TRMToolbarButton.SetAllowAllUp(Value: Boolean);
begin
  AutoCheck := Value;
end;
{$ENDIF}

//dejoy added begin

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMCustomMenuItem}
{$IFDEF USE_TB2k}

function TRMCustomMenuItem.GetRadioItem: boolean;
begin
  Result := AutoCheck;
end;

procedure TRMCustomMenuItem.SetRadioItem(Value: boolean);
begin
  AutoCheck := Value;
end;

procedure TRMCustomMenuItem.SetAddTo(Value: TRMToolBar);
begin
  Value.Items.Add(self);
end;
{$ELSE}

function TRMCustomMenuItem.GetImages: TCustomImageList;
var
  M: TMenu;
begin
  m := GetParentMenu;
  if m <> nil then
    Result := m.Images
  else
    Result := nil;
end;

procedure TRMCustomMenuItem.SetImages(Value: TCustomImageList);
var
  M: TMenu;
begin
  m := GetParentMenu;
  if m <> nil then
    with m do
    begin
      if Images <> Value then
        Images := Value;
    end;
end;
{$ENDIF}

procedure TRMCustomMenuItem.AddToMenu(Value: TRMMenuBar);
begin
  Value.Items.Add(self);
end;

procedure TRMCustomMenuItem.AddToMenu(Value: TRMCustomMenuItem);
begin
  Value.Add(self);
end;

procedure TRMCustomMenuItem.AddToMenu(Value: TRMSubMenuItem);
begin
  Value.Add(self);
end;

procedure TRMCustomMenuItem.AddToMenu(Value: TRMPopupMenu);
begin
  Value.Items.Add(self);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMSubMenuItem}
{$IFDEF USE_TB2K}

procedure TRMSubMenuItem.SetAddTo(Value: TRMToolBar);
begin
  Value.Items.Add(self);
end;

procedure TRMSubMenuItem.AddToMenu(Value: TRMMenuBar);
begin
  Value.Items.Add(self);
end;

procedure TRMSubMenuItem.AddToMenu(Value: TRMCustomMenuItem);
begin
  Value.Add(self);
end;

procedure TRMSubMenuItem.AddToMenu(Value: TRMSubMenuItem);
begin
  Value.Add(self);
end;

procedure TRMSubMenuItem.AddToMenu(Value: TRMPopupMenu);
begin
  Value.Items.Add(self);
end;
{$ENDIF}

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMSeparatorMenuItem }
{$IFDEF USE_TB2K}

procedure TRMSeparatorMenuItem.AddToMenu(Value: TRMMenuBar);
begin
  Value.Items.Add(self);
end;

procedure TRMSeparatorMenuItem.AddToMenu(Value: TRMCustomMenuItem);
begin
  Value.Add(self);
end;

procedure TRMSeparatorMenuItem.AddToMenu(Value: TRMSubMenuItem);
begin
  Value.Add(self);
end;

procedure TRMSeparatorMenuItem.AddToMenu(Value: TRMPopupMenu);
begin
  Value.Items.Add(self);
end;

{$ELSE}

constructor TRMSeparatorMenuItem.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Caption := '-';
end;
{$ENDIF}

{ TCustomComboBox97 }

constructor TCustomComboBox97.Create(AOwner: TComponent);
begin
  inherited;

  FButtonWidth := GetSystemMetrics(SM_CXVSCROLL) + 2;
  FOldColor := inherited Color;
  FOldParentColor := inherited ParentColor;
  FFlat := True;
end;

procedure TCustomComboBox97.SetFlat(const Value: Boolean);
begin
  if Value <> FFlat then
  begin
    FFlat := Value;
    Ctl3D := not Value;
    Invalidate;
  end;
end;

// Verifica si el bot髇 todav韆 deba estar presionado

procedure TCustomComboBox97.CMEnter(var Message: TCMEnter);
begin
  inherited;

  if not (csDesigning in ComponentState) then
    DrawBorders;
end;

procedure TCustomComboBox97.CMExit(var Message: TCMExit);
begin
  inherited;

  if not (csDesigning in ComponentState) then
    DrawBorders;
end;

procedure TCustomComboBox97.CMMouseEnter(var Message: TMessage);
begin
  inherited;

  // Si por primera vez el rat髇 est