flatctrls.pas

comerose_flatstyle_v4.42.9.0_d7.rar

    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property ImeMode;
    property ImeName;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnStartDrag;
  end;

  { TDefineSplitter }
  TDefineHack = class(TWinControl);
  
  TDefineSplitter = class(TVersionGraphic)
  private
    FBorderColor: TColor;
    FFocusedColor: TColor;
    FLineDC: HDC;
    FDownPos: TPoint;
    FSplit: Integer;
    FMinSize: NaturalNumber;
    FMaxSize: Integer;
    FControl: TControl;
    FNewSize: Integer;
    FActiveControl: TWinControl;
    FOldKeyDown: TKeyEvent;
    FLineVisible: Boolean;
    FOnMoved: TNotifyEvent;
    FStatus: TSplitterStatus;
    procedure AllocateLineDC;
    procedure DrawLine;
    procedure ReleaseLineDC;
    procedure UpdateSize(X, Y: Integer);
    procedure FocusKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure SetColors (Index: Integer; Value: TColor);
    procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMParentColorChanged (var Message: TWMNoParams); message CM_PARENTCOLORCHANGED;
    procedure CMEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMExit(var Message: TMessage); message CM_MOUSELEAVE;
  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 StopSizing;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Color default $00E0E9EF;
    property ColorFocused: TColor index 0 read FFocusedColor write SetColors default $0053D2FF;
    property ColorBorder: TColor index 1 read FBorderColor write SetColors default $00555E66;
    property MinSize: NaturalNumber read FMinSize write FMinSize default 30;
    property OnMoved: TNotifyEvent read FOnMoved write FOnMoved;
    property Align default alLeft;
    property Enabled;
    property ParentColor;
    property ParentShowHint;
    property ShowHint;
    property Visible;
  end;
  { TFlatSplitter }
  TFlatSplitter = class(TDefineSplitter)
  published
    property Color;
    property ColorFocused;
    property ColorBorder;
    property MinSize;
    property OnMoved;
    property Align;
    property Enabled;
    property ParentColor;
    property ParentShowHint;
    property ShowHint;
    property Visible;
  end;
  { TDefineAnimation }
  TDefineAnimation = class(TVersionControl)
  private
    FTransparent: Boolean;
    FAnimation: TBitmap;
    FFrames: Integer;
    FFrameWidth: Integer;
    FFrame: Integer;
    FInterval: Integer;
    FTransColor: TColor;
    FActive: Boolean;
    FLoop: Boolean;
    FReverse: Boolean;
    FTimer: TTimer;
    FBorderColor: TColor;
    FBorder: Boolean;
    FFrameChange: TOnFrameChange;
    FAnimationLayout: TAnimationLayout;
    procedure SetAnimation(Value: TBitmap);
    procedure SetFrames(Value: Integer);
    procedure SetFrameWidth(Value: Integer);
    procedure SetFrame(Value: Integer);
    procedure SetActive(Value: Boolean);
    procedure SetTransparent(Value: Boolean);
    procedure SetLoop(Value: Boolean);
    procedure SetReverse(Value: Boolean);
    procedure SetInterval(Value: Integer);
    procedure SetBorder(Value: Boolean);
    procedure DoTimer(Sender: TObject);
    procedure SetColors(Index: Integer; Value: TColor);
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMParentColorChanged(var Message: TWMNoParams); message CM_PARENTCOLORCHANGED;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure SetAnimationLayout(const Value: TAnimationLayout);
  protected
    procedure Paint; override;
    property Animation: TBitmap read FAnimation write SetAnimation;
    property Frames: Integer read FFrames write SetFrames;
    property FrameWidth: Integer read FFrameWidth write SetFrameWidth;
    property Frame: Integer read FFrame write SetFrame default 1;
    property Interval: Integer read FInterval write SetInterval;
    property ColorTransparent: TColor index 0 read FTransColor write SetColors default clFuchsia;
    property ColorBorder: TColor index 1 read FBorderColor write SetColors default DefaultBorderColor;
    property Active: Boolean read FActive write SetActive;
    property Loop: Boolean read FLoop write SetLoop;
    property Reverse: Boolean read FReverse write SetReverse;
    property Border: Boolean read FBorder write SetBorder default false;
    property AnimationLayout: TAnimationLayout read FAnimationLayout write SetAnimationLayout;
    property OnFrameChange: TOnFrameChange read FFrameChange write FFrameChange;
    property Transparent: Boolean read FTransparent write SetTransparent default false;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  { TFlatAnimation }
  TFlatAnimation = class(TDefineAnimation)
  published
    property Color;
    property Animation;
    property Frames;
    property FrameWidth;
    property Frame;
    property Interval;
    property ColorTransparent;
    property ColorBorder;
    property Active;
    property Loop;
    property Reverse;
    property Border;
    property AnimationLayout;
    property OnFrameChange;
    property Transparent;
    property Align;
    property Enabled;
    property ParentColor;
    property ParentShowHint;
    property ShowHint;
    property Visible;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

  { TFlatHint }
  TFlatHint = class(TVersionComponent)
  private
    FHintFont: TFont;
    FBackgroundColor: TColor;
    FBorderColor: TColor;
    FArrowBackgroundColor: TColor;
    FArrowColor: TColor;
    FHintWidth: Integer;
    FOnShowHint: TShowHintEvent;
    procedure SetColors (Index: Integer; Value: TColor);
    procedure SetHintFont (Value: TFont);
    procedure GetHintInfo (var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ColorBackground: TColor index 0 read FBackgroundColor write SetColors default clWhite;
    property ColorBorder: TColor index 1 read FBorderColor write SetColors default clBlack;
    property ColorArrowBackground: TColor index 2 read FArrowBackgroundColor write SetColors default $0053D2FF;
    property ColorArrow: TColor index 3 read FArrowColor write SetColors default clBlack;
    property MaxWidth: Integer read FHintWidth write FHintWidth default 200;
    property Font: TFont read FHintFont write SetHintFont;
    property OnShowHint: TShowHintEvent read FOnShowHint write FOnShowHint;
  end;
  { TFlatHintWindow }
  TFlatHintWindow = class(THintWindow)
  private
    FArrowPos: TArrowPos;
    FArrowPoint: TPoint;
    FHint: TFlatHint;
    function FindFlatHint: TFlatHint;
  protected
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
  public
    procedure ActivateHint(HintRect: TRect; const AHint: string); Override;
  end;

  TDefineImage = class(TVersionGraphic)
  private
    FBitmap: TBitmap;
    FOnProgress: TProgressEvent;
    FStretch: Boolean;
    FCenter: Boolean;
    FIncrementalDisplay: Boolean;
    FTransparent: Boolean;
    FDrawing: Boolean;
    FProportional: Boolean;    
    procedure PictureChanged(Sender: TObject);
    procedure SetCenter(Value: Boolean);
    procedure SetPicture(Value: TBitmap);
    procedure SetStretch(Value: Boolean);
    procedure SetTransparent(Value: Boolean);
    procedure SetProportional(Value: Boolean);
  protected
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
    function DestRect: TRect;
    function DoPaletteChange: Boolean;
    function GetPalette: HPALETTE; override;
    function GetCanvas: TCanvas;
    procedure Paint; override;
    procedure Progress(Sender: TObject; Stage: TProgressStage;
              PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic;
    property Center: Boolean read FCenter write SetCenter default False;
    property IncrementalDisplay: Boolean read FIncrementalDisplay write FIncrementalDisplay default False;
    property Proportional: Boolean read FProportional write SetProportional default false;
    property Stretch: Boolean read FStretch write SetStretch default False;
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Bitmap: TBitmap read FBitmap write SetPicture;
    property Canvas: TCanvas read GetCanvas;
    property OnMouseMove;
  end;

  TFlatImage = class(TDefineImage)
  published
    property Align;
    property Anchors;
    property AutoSize;
    property Center;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property IncrementalDisplay;
    property ParentShowHint;
    property Bitmap;
    property PopupMenu;
    property Proportional;
    property ShowHint;
    property Stretch;
    property Transparent;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnProgress;
    property OnStartDock;
    property OnStartDrag;
  end;

  TDefineTimer = class(TVersionComponent)
  private
    FInterval: Cardinal;
    FHandle: HWND;
    FOnTimer: TNotifyEvent;
    FEnabled: Boolean;
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: Cardinal);
    procedure SetOnTimer(Value: TNotifyEvent);
  protected
    procedure Timer; dynamic;
    procedure UpdateTimer;
    procedure WndProc(var Msg: TMessage);
    property  Enabled: Boolean read FEnabled write SetEnabled default True;
    property  Interval: Cardinal read FInterval write SetInterval default 50;
    property  OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TDefineWater = class(TDefineTimer)
  private
    FState: Integer;
    FParam: TOtherParam;
    FDamping: TWaterDamping;
    FBitmap: TBitmap;
    FImage: TDefineImage;
    FPlayState: boolean;
    FItems: TStringList;
    procedure SetDamping(Value: TWaterDamping);
    procedure SetItems(const Value: TStringList);
  protected
    FWater: TDefineWatet;
    FMoveHeight: Integer;
    procedure OnMouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);
    procedure Play(sender: TObject);
    procedure InitiateWater;
    property  Bitmap: TBitmap read FBitmap;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Damping: TWaterDamping read FDamping write SetDamping;
    property CtrlImage: TDefineImage read FImage write FImage;
    property Items: TStringList read FItems write SetItems;
    property Enabled;
    property Interval;
  end;

  TFlatWater = class(TDefineWater)
  published
    property Damping;
    property CtrlImage;
    property Items;
    property Enabled;
    property Interval;
  end;

implementation

uses Clipbrd, FlatConsts;

{ TFlatTicket }
constructor TFlatTicket.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Name     := 'Ticket';  { do not localize }
  SetSubComponent(True);
  if Assigned(AOwner) then
     Caption := AOwner.Name;
  AutoSize := True;
end;

procedure TFlatTicket.AdjustBounds;
begin
  inherited AdjustBounds;
  if Owner is TDefineEdit then begin
    with Owner as TDefineEdit do begin
         SetTicketPosition(TicketPosition);
    end;
  end;
  if Owner is TDefineComboBox then begin
    with Owner as TDefineComboBox do
      SetTicketPosition(TicketPosition);
  end;
  if Owner is TDefineColorBox then begin
    with Owner as TDefineColorBox do
      SetTicketPosition(TicketPosition);
  end;
end;

function TFlatTicket.GetHeight: Integer;
begin
  Result := inherited Height;
end;

function TFlatTicket.GetLeft: Integer;
begin
  Result := inherited Left;
end;

function TFlatTicket.GetTop: Integer;
begin
  Result := inherited Top;
end;

function TFlatTicket.GetWidth: Integer;
begin
  Result := inherited Width;
end;

procedure TFlatTicket.SetHeight(const Value: Integer);
begin
  SetBounds(Left, Top, Width, Value);
end;

procedure TFlatTicket.SetWidth(const Value: Integer);
begin
  SetBounds(Left, Top, Value, Height);
end;

{ TDefineEdit }

procedure TDefineEdit.SetupInternalLabel;
begin
  if not(csDesigning in ComponentState) then begin
     fLabel           := TLabel.Create(Self);
     fLabel.Parent    := self;
     fLabel.OnClick   := LabelMouseEnter;
     fLabel.AutoSize  := false;
     fLabel.Visible   := false;
     fLabel.Transparent  := True;