dxbarextitems.pas

胜天进销存源码,国产优秀的进销存

    function GetCurValue: Extended;
    function GetIntCurValue: Integer;
    function GetIntValue: Integer;
    function GetValue: Extended;
    procedure SetCurValue(Value: Extended);
    procedure SetIncrement(Value: Extended);
    procedure SetIntCurValue(Value: Integer);
    procedure SetIntValue(Value: Integer);
    procedure SetMaxValue(Value: Extended);
    procedure SetMinValue(Value: Extended);
    procedure SetPrefix(const Value: string);
    procedure SetPrefixPlace(Value: TdxBarSpinEditPrefixPlace);
    procedure SetValue(Value: Extended);
    procedure SetValueType(Value: TdxBarSpinEditValueType);

    function IsIncrementStored: Boolean;
    function IsMaxValueStored: Boolean;
    function IsMinValueStored: Boolean;
    function IsValueStored: Boolean;

    procedure AddPrefix(var Text: string);
    procedure RemovePrefix(var Text: string);
  protected
    function CheckRange: Boolean;
    procedure DoButtonClick(Button: TdxBarSpinEditButton);
    function GetCheckedValue(Value: Extended): Extended;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure PrepareValue(var Value: Extended);
    function TextToValue(Text: string): Extended;
    procedure SetText(Value: string); override;
    function ValueToText(Value: Extended): string;
  public
    constructor Create(AOwner: TComponent); override;
    property CurValue: Extended read GetCurValue write SetCurValue;
    property IntCurValue: Integer read GetIntCurValue write SetIntCurValue;
    property IntValue: Integer read GetIntValue write SetIntValue;
  published
    property ValueType: TdxBarSpinEditValueType read FValueType write SetValueType
      default svtInteger;  // must be loaded before all
    property Increment: Extended read FIncrement write SetIncrement
      stored IsIncrementStored;
    property MaxValue: Extended read FMaxValue write SetMaxValue stored IsMaxValueStored;
    property MinValue: Extended read FMinValue write SetMinValue stored IsMinValueStored;
    property Prefix: string read FPrefix write SetPrefix;
    property PrefixPlace: TdxBarSpinEditPrefixPlace read FPrefixPlace write SetPrefixPlace
      default ppEnd;
    property Text stored False;
    property Value: Extended read GetValue write SetValue stored IsValueStored;
    property OnButtonClick: TdxBarSpinEditButtonClickEvent read FOnButtonClick
      write FOnButtonClick;
  end;

  TdxBarSpinEditControl = class(TdxBarEditControl)
  private
    FActiveButtonIndex: Integer;
    FTimerID: UINT;
    function GetActiveButton: TdxBarSpinEditButton;
    function GetButtonPressed: Boolean;
    function GetDrawParams: TdxBarSpinEditDrawParams;
    function GetItem: TdxBarSpinEdit;
    procedure SetActiveButtonIndex(Value: Integer);
  protected
    procedure BreakProcess;
    procedure CalcDrawParams(AFull: Boolean = True); override;
    procedure CalcParts; override;
    procedure CorrectFrameRect(var ARect: TRect); override;
    procedure DrawTextField; override;
    function GetDrawParamsClass: TdxBarItemControlDrawParamsClass; override;
    function GetPartCount: Integer; override;
    procedure KillFocus(AHandle: THandle); override;
    procedure WndProc(var Message: TMessage); override;
    property ActiveButton: TdxBarSpinEditButton read GetActiveButton;
    property ActiveButtonIndex: Integer read FActiveButtonIndex write SetActiveButtonIndex;
    property ButtonPressed: Boolean read GetButtonPressed;
    property DrawParams: TdxBarSpinEditDrawParams read GetDrawParams;
  public
    property Item: TdxBarSpinEdit read GetItem;
  end;

  TdxBarControlContainerItem = class(TdxBarItem)
  private
    FControl: TControl;
    FPlace: TCustomForm;
    FPrevControlSize: TPoint;
    FPrevControlWndProc: TWndMethod;
    function GetControlVisible: Boolean;
    function GetInPlaceControl: Boolean;
    procedure SetControl(Value: TControl);
    procedure ControlWndProc(var Message: TMessage);
    function IsControlAssigned(AControl: TControl): Boolean;
    procedure SaveControlSize;
    procedure SetControlVisible(Value: Boolean);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetName(const NewName: TComponentName); override;

    function CanClicked: Boolean; override;
    function GetHidden: Boolean; override;
    function HasAccel(AItemLink: TdxBarItemLink): Boolean; override;
    procedure HideControl(AControl: TdxBarItemControl); override;
    function NeedToBeHidden: Boolean; override;

    property ControlVisible: Boolean read GetControlVisible write SetControlVisible;
    property InPlaceControl: Boolean read GetInPlaceControl;
    property Place: TCustomForm read FPlace;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Control: TControl read FControl write SetControl;
  end;

  TdxBarControlContainerControl = class(TdxBarItemControl)
  private
    FInPlaceControl: Boolean;
    FPlacedControl: Boolean;
    function GetItem: TdxBarControlContainerItem;
    function GetPlace: TCustomForm;
    procedure InternalPaint;
    procedure PlaceControl;
  protected
    procedure BeforeDestroyParentHandle; override;
    procedure CalcParts; override;
    function CanClicked: Boolean; override;
    function CanSelect: Boolean; override;
    procedure DoPaint(ARect: TRect; PaintType: TdxBarPaintType); override;
    function GetControl: TControl; override;
    function GetDefaultHeight: Integer; override;
    function GetDefaultWidth: Integer; override;
    function IsDestroyOnClick: Boolean; override;
    function IsHitTestTransparent: Boolean; override;
    function IsShowingControl: Boolean;
    function NeedCaptureMouse: Boolean; override;

    procedure RealVisibleChanging(AVisible: Boolean); override;
    function ShowsControl: Boolean;

    property InPlaceControl: Boolean read FInPlaceControl;
    property Place: TCustomForm read GetPlace;
  public
    destructor Destroy; override;
    property Item: TdxBarControlContainerItem read GetItem;
  end;

  TdxBarProgressItem = class(TdxBarStatic)
  private
    FColor: TColor;
    FMax: Integer;
    FMin: Integer;
    FPosition: Integer;
    FSmooth: Boolean;
    FStep: Integer;
    procedure SetColor(Value: TColor);
    procedure SetMax(Value: Integer);
    procedure SetMin(Value: Integer);
    procedure SetPosition(Value: Integer);
    procedure SetSmooth(Value: Boolean);
    procedure SetStep(Value: Integer);
  protected
    procedure UpdateBar;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetParams(AMin, AMax: Integer);
    procedure StepBy(Delta: Integer);
    procedure StepIt;
  published
    property BorderStyle default sbsLowered;
    property Color: TColor read FColor write SetColor default clDefault;
    property Max: Integer read FMax write SetMax default 100;
    property Min: Integer read FMin write SetMin default 0;
    property Position: Integer read FPosition write SetPosition default 0;
    property Smooth: Boolean read FSmooth write SetSmooth default False;
    property Step: Integer read FStep write SetStep default 10;
  end;

  TdxBarProgressControl = class(TdxBarStaticControl)
  private
    function GetDrawParams: TdxbarProgressControlDrawParams;
    function GetItem: TdxBarProgressItem;
  protected
    function BarBrushColor: TColorRef; virtual;
    function BarHeight: Integer;
    function BarRect: TRect;
    function BarWidth: Integer;
    procedure CalcDrawParams(AFull: Boolean); override;
    function CanHaveZeroSize: Boolean; override;
    procedure DrawInterior(ARect: TRect); override;
    function GetAlignment: TAlignment; override;
    function GetDrawParamsClass: TdxBarItemControlDrawParamsClass; override;
    function GetPossibleViewLevels: TdxBarItemViewLevels; override;
    function InternalGetDefaultHeight: Integer; override;
    function InternalGetDefaultWidth: Integer; override;
    procedure UpdateBar;
    property DrawParams: TdxbarProgressControlDrawParams read GetDrawParams;
  public
    property Item: TdxBarProgressItem read GetItem;
  end;

  TdxBarMRUListItem = class(TdxBarListItem)
  private
    FMaxItemCount: Integer;
    FRemoveItemOnClick: Boolean;
    procedure SetMaxItemCount(Value: Integer);
  protected
    procedure CheckItemCount;
    function GetDisplayText(const AText: string): string; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure DirectClick; override;
    procedure AddItem(const S: string; AObject: TObject);
    procedure RemoveItem(const S: string; AObject: TObject);
  published
    property MaxItemCount: Integer read FMaxItemCount write SetMaxItemCount default 5;
    property RemoveItemOnClick: Boolean read FRemoveItemOnClick
      write FRemoveItemOnClick default False;
  end;

  TdxBarInPlaceSubItem = class;

  TdxBarInPlaceSubItemEvent =
    procedure(Sender: TdxBarInPlaceSubItem; Link: TdxBarItemLink) of object;

  TdxBarInPlaceSubItem = class(TdxBarContainerItem)
  private
    FExpanded: Boolean;
    FExpandedChanging: Boolean;
    FKeepBeginGroupWhileExpanded: Boolean;
    FOnAfterExpand: TdxBarInPlaceSubItemEvent;
    FOnBeforeCollapse: TdxBarInPlaceSubItemEvent;
    procedure SetExpanded(Value: Boolean);
  protected
    procedure AddListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer;
      FirstCall: Boolean; CallingItemLink: TdxBarItemLink); override;
    procedure DeleteListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer); override;
    function HideWhenRun: Boolean; override;
    function InternalActuallyVisible: Boolean; override;
    function InternalCanMergeWith(AItem: TdxBarItem): Boolean; override;

    procedure ChangeNextItemLinkBeginGroup(ALink: TdxBarItemLink; Value: Boolean);
    procedure DoAfterExpand(ALink: TdxBarItemLink); dynamic;
    procedure DoBeforeCollapse(ALink: TdxBarItemLink); dynamic;
  published
    property Expanded: Boolean read FExpanded write SetExpanded default False;
    property KeepBeginGroupWhileExpanded: Boolean read FKeepBeginGroupWhileExpanded
      write FKeepBeginGroupWhileExpanded;
    property OnAfterExpand: TdxBarInPlaceSubItemEvent read FOnAfterExpand
      write FOnAfterExpand;
    property OnBeforeCollapse: TdxBarInPlaceSubItemEvent read FOnBeforeCollapse
      write FOnBeforeCollapse;
  end;

  TdxBarInPlaceSubItemControl = class(TdxBarContainerItemControl)
  private
    function GetDrawParams: TdxBarInPlaceSubItemControlDrawParams;
    function GetItem: TdxBarInPlaceSubItem;
  protected
    procedure CalcDrawParams(AFull: Boolean = False); override;
    procedure ControlClick(AByMouse: Boolean; AKey: Char = #0); override;
    procedure DblClick; override;
    procedure DoPaint(ARect: TRect; PaintType: TdxBarPaintType); override;
    function GetAccessibilityHelperClass: TdxBarAccessibilityHelperClass; override;
    function GetDefaultHeight: Integer; override;
    function GetDefaultWidth: Integer; override;
    function GetDrawParamsClass: TdxBarItemControlDrawParamsClass; override;
    function HasSubMenu: Boolean; override;
    function IsExpandable: Boolean; override;
    function IsInvertTextColor: Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    function WantsKey(Key: Word): Boolean; override;

    property DrawParams: TdxBarInPlaceSubItemControlDrawParams read GetDrawParams;
  public
    property Item: TdxBarInPlaceSubItem read GetItem;
  end;

  { TdxBarInPlaceSubItemControlAccessibilityHelper }

  TdxBarInPlaceSubItemControlAccessibilityHelper = class(TdxBarSubItemControlAccessibilityHelper)
  protected
    function ShowDropDownWindow: Boolean; override;
  end;

var
  // first day of week
  StartOfWeek: Word;  //TDayOfWeek;

// Use cxSetResourceString instead global variable
// for example, old code:
//   sdxBarDatePopupToday := ...
// new code:
//   cxSetResourceString(@dxSBAR_DATETODAY, ...);
function sdxBarDatePopupToday: string;
function sdxBarDatePopupClear: string;

function dxBarColorDialog: TColorDialog;
function dxBarFontDialog: TFontDialog;

implementation

{$R dxBarExtItems.res}

uses
  Math, SysUtils, ActiveX, Printers, dxBarCommon, dxBarStrs,
  cxClasses, cxGraphics, cxGeometry, cxDateUtils;

const
  Colors: array[0..15] of TColor =
    (clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clGray,
     clSilver, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clWhite);
  ADateNavigatorTime = 170;
  ProgressBarDefaultWidth = 150;
  ProgressBarIndent = 2;

type
  TWinControlAccess = class(TWinControl);
  TBarManagerAccess = class(TdxBarManager);
  TCustomdxBarControlAccess = class(TCustomdxBarControl);
  TdxBarItemActionLinkAccess = class(TdxBarItemActionLink);
  TPlaceForm = class(TCustomForm)
  private
    FBarItemControl: TdxBarItemControl;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

procedure TPlaceForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  APrevWindowOrg: TPoint;
  R: TRect;
begin
  if FBarItemControl = nil then
    FillRect(Message.DC, ClientRect, Brush.Handle)
  else
  begin
    R := ClientRect;
    BeforeDrawBackground(Self, FBarItemControl.Parent, Message.DC, R, APrevWindowOrg);
    try
      BarCanvas.BeginPaint(Message.DC);
      try
        FBarItemControl.Painter.DrawItemBackground(FBarItemControl, BarCanvas, R, Brush.Handle);
      finally
        BarCanvas.EndPaint;
      end;
    finally
      AfterDrawBackground(Message.DC, APrevWindowOrg);
    end;
  end;
  Message.Result := 1;
end;

procedure TPlaceForm.WndProc(var Message: TMessage);
begin
  inherited WndProc(Message);
  if Message.Msg = dxWMGetSkinnedMessage then
    Message.Result := 1;
end;

var
  FColorDialog: TColorDialog;
  FFontDialog: TFontDialog;
  FTrueTypeFontBitmap, FNonTrueTypeFontBitmap: TBitmap;

function GetCuttedString(const S: string): string;
var
  C: PChar;
  R: TRect;
  DC: HDC;
begin
  GetMem(C, 2 * (MAX_PATH + 1));
  StrPCopy(C, S);
  R := Rect(0, 0, 300, 100);
  DC := GetDC(0);
  DrawText(DC, C, Length(S), R,
    DT_CALCRECT or DT_MODIFYSTRING or
    DT_NOPREFIX or DT_SINGLELINE or DT_PATH_ELLIPSIS);