rm_ctrls.pas

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

unit RM_Ctrls;

interface

{$I RM.inc}
{$R RM_common.res}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, Commctrl, Menus, Mask, Buttons, RM_Common
{$IFDEF USE_TB2K}
  , TB2Item, TB2ExtItems, TB2Dock, TB2Toolbar, TB2ToolWindow, TB2Common
{$ELSE}
{$IFDEF USE_INTERNALTB97}
  , RM_TB97Ctls, RM_TB97Tlbr, RM_TB97, RM_TB97Tlwn
{$ELSE}
  , TB97Ctls, TB97Tlbr, TB97, TB97Tlwn
{$ENDIF}
{$ENDIF}
{$IFDEF DELPHI4}, ImgList{$ENDIF}
{$IFDEF Delphi6}, Variants{$ENDIF};

const
  MaxColorButtonNumber = 40;

type
  TRMSubMenuItem = class;

  {TRMDock}
{$IFDEF USE_TB2k}
  TRMDock = TTBDock;
{$ELSE}
  TRMDock = class(TDock97);
{$ENDIF}

  {TRMToolbar}
{$IFDEF USE_TB2k}
  TRMToolbar = class(TTBToolbar)
  private
    function GetDockedto: TRMDock;
    procedure SetDockedto(Value: TRMDock);
  public
    property Dockedto: TRMDock read GetDockedto write SetDockedto;
  end;
{$ELSE}
  TRMToolbar = TToolbar97;
{$ENDIF}

  {TRMToolbarSep}
{$IFDEF USE_TB2k}
  TRMToolbarSep = class(TTBSeparatorItem)
{$ELSE}
  TRMToolbarSep = class(TToolbarSep97)
{$ENDIF}
  private
    procedure SetAddTo(Value: TRMToolbar);
  public
    property AddTo: TRMToolbar write SetAddTo;
  end;

  {TRMEdit}
{$IFDEF USE_TB2K}
  TRMEdit = class(TTBEditItem)
{$ELSE}
  TRMEdit = class(TEdit97)
{$ENDIF}
  private
    procedure SetAddTo(Value: TRMToolbar);
  public
    property AddTo: TRMToolbar write SetAddTo;
  end;

  {TRMMenuBar}
{$IFDEF USE_TB2K}
  TRMMenuBar = TRMToolbar;
{$ELSE}
  TRMMenuBar = class(TMainMenu)
  public
    Dockedto: TRMDock;
    MenuBar: Boolean;
  end;
{$ENDIF}

  {TRMPopupMenu}
{$IFDEF USE_TB2k}
  TRMPopupMenu = TTBPopupMenu;
{$ELSE}
  TRMPopupMenu = TPopupMenu;
{$ENDIF}

  {TRMCustomMenuItem}
{$IFDEF USE_TB2K}
  TRMCustomMenuItem = class(TTBItem)
  private
    function GetRadioItem: boolean;
    procedure SetRadioItem(Value: boolean);
    procedure SetAddTo(Value: TRMToolbar);
  public
    property RadioItem: boolean read GetRadioItem write SetRadioItem;
    property AddTo: TRMToolbar write SetAddTo;
{$ELSE}
  TRMCustomMenuItem = class(TMenuItem)
  private
    function GetImages: TCustomImageList;
    procedure SetImages(Value: TCustomImageList);
  public
    property Images: TCustomImageList read GetImages write SetImages;
{$ENDIF}
  public
    procedure AddToMenu(Value: TRMMenuBar); overload;
    procedure AddToMenu(Value: TRMCustomMenuItem); overload;
    procedure AddToMenu(Value: TRMSubMenuItem); overload;
    procedure AddToMenu(Value: TRMPopupMenu); overload;
  end;

  TRMMenuItem = class(TRMCustomMenuItem);

  {TRMSubMenuItem}
{$IFDEF USE_TB2K}
  TRMSubMenuItem = class(TTBSubmenuItem)
  private
    procedure SetAddTo(Value: TRMToolbar);
  public
    procedure AddToMenu(Value: TRMMenuBar); overload;
    procedure AddToMenu(Value: TRMCustomMenuItem); overload;
    procedure AddToMenu(Value: TRMSubMenuItem); overload;
    procedure AddToMenu(Value: TRMPopupMenu); overload;
    property AddTo: TRMToolbar write SetAddTo;
  end;
{$ELSE}
  TRMSubMenuItem = class(TRMMenuItem);
{$ENDIF}

  {TRMSeparatorMenuItem}
{$IFDEF USE_TB2K}
  TRMSeparatorMenuItem = class(TTBSeparatorItem)
  public
    procedure AddToMenu(Value: TRMMenuBar); overload;
    procedure AddToMenu(Value: TRMCustomMenuItem); overload;
    procedure AddToMenu(Value: TRMSubMenuItem); overload;
    procedure AddToMenu(Value: TRMPopupMenu); overload;
  end;
{$ELSE}
  TRMSeparatorMenuItem = class(TRMMenuItem)
  private
  public
    constructor Create(AOwner: TComponent); override;
  end;
{$ENDIF}

{$IFDEF USE_TB2k}
  TRMToolbarButton = class(TTBItem)
  private
    function GetDown: Boolean;
    procedure SetDown(Value: Boolean);
    function GetAllowAllUp: Boolean;
    procedure SetAllowAllUp(Value: Boolean);
    procedure SetAddTo(Value: TRMToolBar);
  public
    property AddTo: TRMToolBar write SetAddTo;
    property AllowAllUp: Boolean read GetAllowAllup write SetAllowAllup;
    property Down: Boolean read GetDown write SetDown;
  end;
{$ELSE}
  TRMToolbarButton = class(TToolbarButton97)
  private
    procedure SetAddTo(Value: TRMToolBar);
  public
    property AddTo: TRMToolBar write SetAddTo;
  end;
{$ENDIF}

  TComboState97 = set of (csButtonPressed, csMouseCaptured);

  TCustomComboBox97 = class(TCustomComboBox)
  private
    FFlat: Boolean;
    FOldColor: TColor;
    FOldParentColor: Boolean;
    FButtonWidth: Integer;
    FEditState: TComboState97;
    FMouseInControl: Boolean;
    procedure SetFlat(const Value: Boolean);
    procedure DrawButtonBorder(DC: HDC);
    procedure DrawControlBorder(DC: HDC);
    procedure DrawBorders;
    function NeedDraw3DBorder: Boolean;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    procedure TrackButtonPressed(X, Y: Integer);
    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;

    property Flat: Boolean read FFlat write SetFlat default True;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TRMComboBox97 = class(TCustomComboBox97)
  published
    property Style; // Debe ser siempre la primera
    property Flat;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property Font;
    property ItemHeight;
    property Items;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnStartDrag;
  end;

  TRMSpinButtonState = (rmsbNotDown, rmsbTopDown, rmsbBottomDown);

  {TRMSpinButton}
  TRMSpinButton = class(TGraphicControl)
  private
    FDown: TRMSpinButtonState;
    FUpBitmap: TBitmap;
    FDownBitmap: TBitmap;
    FDragging: Boolean;
    FInvalidate: Boolean;
    FTopDownBtn: TBitmap;
    FBottomDownBtn: TBitmap;
    FRepeatTimer: TTimer;
    FNotDownBtn: TBitmap;
    FLastDown: TRMSpinButtonState;
    FFocusControl: TWinControl;
    FOnTopClick: TNotifyEvent;
    FOnBottomClick: TNotifyEvent;
    procedure TopClick;
    procedure BottomClick;
    procedure GlyphChanged(Sender: TObject);
    procedure SetDown(Value: TRMSpinButtonState);
    procedure DrawAllBitmap;
    procedure DrawBitmap(ABitmap: TBitmap; ADownState: TRMSpinButtonState);
    procedure TimerExpired(Sender: TObject);
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure Paint; override;
    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 Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Down: TRMSpinButtonState read FDown write SetDown default rmsbNotDown;
  published
  end;

  {TRMSpinEdit}

  TRMValueType = (rmvtInteger, rmvtFloat);

  TRMSpinEdit = class(TCustomEdit)
  private
    FAlignment: TAlignment;
    FMinValue: Extended;
    FMaxValue: Extended;
    FIncrement: Extended;
    FDecimal: Byte;
    FChanging: Boolean;
    FEditorEnabled: Boolean;
    FValueType: TRMValueType;
    FButton: TRMSpinButton;
    FBtnWindow: TWinControl;
    FArrowKeys: Boolean;
    FOnTopClick: TNotifyEvent;
    FOnBottomClick: TNotifyEvent;
    FUpDown: TCustomUpDown;
    procedure UpDownClick(Sender: TObject; Button: TUDBtnType);
    function GetMinHeight: Integer;
    procedure GetTextHeight(var SysHeight, Height: Integer);
    function GetValue: Extended;
    function CheckValue(NewValue: Extended): Extended;
    function GetAsInteger: Longint;
    function IsIncrementStored: Boolean;
    function IsValueStored: Boolean;
    procedure SetArrowKeys(Value: Boolean);
    procedure SetAsInteger(NewValue: Longint);
    procedure SetValue(NewValue: Extended);
    procedure SetValueType(NewType: TRMValueType);
    procedure SetDecimal(NewValue: Byte);
    function GetButtonWidth: Integer;
    procedure RecreateButton;
    procedure ResizeButton;
    procedure SetEditRect;
    procedure SetAlignment(Value: TAlignment);
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CMEnter(var Message: TMessage); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
    procedure WMCut(var Message: TWMCut); message WM_CUT;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
{$IFDEF Delphi4}
    procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
{$ENDIF}
  protected
    procedure Change; override;
    function IsValidChar(Key: Char): Boolean; virtual;
    procedure UpClick(Sender: TObject); virtual;
    procedure DownClick(Sender: TObject); virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property AsInteger: Longint read GetAsInteger write SetAsInteger default 0;
    property Text;
  published
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property ArrowKeys: Boolean read FArrowKeys write SetArrowKeys default True;
    property Decimal: Byte read FDecimal write SetDecimal default 2;
    property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
    property Increment: Extended read FIncrement write FIncrement stored IsIncrementStored;
    property MaxValue: Extended read FMaxValue write FMaxValue;
    property MinValue: Extended read FMinValue write FMinValue;
    property ValueType: TRMValueType read FValueType write SetValueType;
    property Value: Extended read GetValue write SetValue stored IsValueStored;
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnBottomClick: TNotifyEvent read FOnBottomClick write FOnBottomClick;
    property OnTopClick: TNotifyEvent read FOnTopClick write FOnTopClick;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

  { TRMPopupWindow }
  TRMPopupWindow = class(TForm)
  private
    FSave: HWND;
    FForm: TCustomForm;
    FCaller: TControl;
    FWidth: Integer;
    FOnClose: TNotifyEvent;
    FOnPopup: TNotifyEvent;

    procedure DoClosePopupWindow;
    procedure WMKILLFOCUS(var message: TWMKILLFOCUS); message WM_KILLFOCUS;
    procedure PopupWindow(ACaller: TControl);
  protected
    procedure DestroyWnd; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
  public
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
    procedure Close(Sender: TObject = nil);
    procedure Popup(ACaller: TControl);

    property Caller: TControl read FCaller;
  published
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnPopup: TNotifyEvent read FOnPopup write FOnPopup;
  end;

  { TRMPopupWindowButton }

  TRMPopupWindowButton = {$IFDEF USE_TB2K}class(TSpeedButton){$ELSE}class(TRMToolbarButton){$ENDIF}
  private
    FActive: Boolean;
    FDropDownPanel: TRMPopupWindow;

    procedure SetActive(aValue: Boolean);
    procedure DropdownPanel_OnClose(Sender: TObject);
    procedure ShowDropDownPanel;
  protected
    function GetDropDownPanel: TRMPopupWindow; virtual;
    procedure SetDropdownPanel(Value: TRMPopupWindow);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Click; override;

    property Active: Boolean read FActive write SetActive;
  published
    property DropDownPanel: TRMPopupWindow read GetDropDownPanel write SetDropdownPanel;
  end;

  { TRMColorPickerButton }

  TRMColorType = (rmptFont, rmptLine, rmptFill, rmptHighlight, rmptCustom);

  TRMColorSpeedButton = class(TSpeedButton)
  private
    FCurColor: TColor;
  protected
    procedure Paint; override;
  published
    property CurColor: TColor read FCurColor write FCurColor;
  end;

  TRMColorPickerButton = class(TRMPopupWindowButton)
  private
    FPopup: TRMPopupWindow;

    FColorButtons: array[0..MaxColorButtonNumber - 1] of TRMColorSpeedButton;
    FAutoButton: TRMColorSpeedButton;
    FOtherButton: TSpeedButton;
    FColorDialog: TColorDialog;
    FColorType: TRMColorType;
    FCurrentColor: TColor;
    FAutoColor: TColor;
    FAutoCaption: string;

    FHoriMargin: integer;
    FTopMargin: integer;
    FBottomMargin: integer;
    FDragBarHeight: integer;
    FDragBarSpace: integer;
    FButtonHeight: integer;
    FColorSpace: integer;
    FColorSize: integer;
    FColorSpaceTop: integer;
    FColorSpaceBottom: integer;

    FOnColorChange: TNotifyEvent;