jvxpcore.pas

East make Tray Icon in delphi

    procedure SetDithered(Value: Boolean); virtual;
    procedure SetColors(Value: TJvXPGradientColors); virtual;
    procedure SetEnabled(Value: Boolean); virtual;
    procedure SetEndColor(Value: TColor); virtual;
    procedure SetGradientStyle(Value: TJvXPGradientStyle); virtual;
    procedure SetStartColor(Value: TColor); virtual;
  public
    Bitmap: TBitmap;
    constructor Create(AOwner: TControl);
    destructor Destroy; override;
    procedure RecreateBands; virtual;
  published
    property Dithered: Boolean read FDithered write SetDithered default True;
    property Colors: TJvXPGradientColors read FColors write SetColors default 16;
    property Enabled: Boolean read FEnabled write SetEnabled default False;
    property EndColor: TColor read FEndColor write SetEndColor default clSilver;
    property StartColor: TColor read FStartColor write SetStartColor default clGray;
    property Style: TJvXPGradientStyle read FGradientStyle write SetGradientStyle default gsLeft;
  end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvXPCore.pas,v $';
    Revision: '$Revision: 1.31 $';
    Date: '$Date: 2005/02/17 10:21:18 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  {$IFDEF USEJVCL}
  JvResources,
  {$ENDIF USEJVCL}
  JvXPCoreUtils;

{$IFDEF MSWINDOWS}
{$R ..\Resources\JvXPCore.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvXPCore.res}
{$ENDIF UNIX}

{$IFNDEF USEJVCL}
resourcestring
  RsCopyright = 'Design eXperience. (c) 2002 M. Hoffmann Version ';
  RsCopyright2 = 'Design eXperience II - (c) 2002 M. Hoffmann Version ';
  RsVersion = '2.0.1'; // always increase version number on new releases!
{$ENDIF !USEJVCL}

//=== { TJvXPCustomComponent } ===============================================

constructor TJvXPCustomComponent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  {$IFNDEF USEJVCL}
  FVersion := RsCopyright + RsVersion;
  {$ENDIF !USEJVCL}
end;

{$IFNDEF USEJVCL}
procedure TJvXPCustomComponent.SetVersion(const Value: string);
begin
  // do not enable overwriting this constant.
end;
{$ENDIF !USEJVCL}

//=== { TJvXPCustomControl } =================================================

constructor TJvXPCustomControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque, csReplicatable];
  DoubleBuffered := True;
  ExControlStyle := [csRedrawEnabledChanged, csRedrawFocusedChanged,
    csRedrawMouseDown, csRedrawMouseEnter, csRedrawMouseLeave, csRedrawMouseUp,
    csRedrawParentColorChanged, csRedrawCaptionChanged];
  FClicking := False;
  FDrawState := [dsDefault];
  FIsLocked := False;
  FIsSibling := False;
  FModalResult := 0;
  {$IFNDEF USEJVCL}
  FVersion := RsCopyright2 + RsVersion;
  {$ENDIF !USEJVCL}
end;

{$IFNDEF USEJVCL}
procedure TJvXPCustomControl.SetVersion(const Value: string);
begin
  // disallow changing this property.
end;
{$ENDIF !USEJVCL}

procedure TJvXPCustomControl.BeginUpdate;
begin
  FIsLocked := True;
end;

procedure TJvXPCustomControl.EndUpdate;
begin
  FIsLocked := False;
  InternalRedraw;
end;

procedure TJvXPCustomControl.LockedInvalidate;
begin
  if not IsLocked then
    Invalidate;
end;

procedure TJvXPCustomControl.InternalRedraw;
begin
  if not FIsLocked then
    Invalidate;
end;

{$IFDEF VCL}

procedure TJvXPCustomControl.CMDialogChar(var Msg: TCMDialogChar);
begin
  with Msg do
  if IsAccel(CharCode, Caption) and CanFocus and
    (Focused or ((GetKeyState(VK_MENU) and $8000) <> 0)) then
  begin
    Click;
    Result := 1;
  end
  else
    inherited;
end;

procedure TJvXPCustomControl.CMBorderChanged(var Msg: TMessage);
begin
  // delegate message "BorderChanged" to hook.
  inherited;
  HookBorderChanged;
end;

procedure TJvXPCustomControl.CMEnabledChanged(var Msg: TMessage);
begin
  // delegate message "EnabledChanged" to hook.
  inherited;
  HookEnabledChanged;
end;
{$ENDIF VCL}

procedure TJvXPCustomControl.CMFocusChanged(var Msg: TMessage);
begin
  // delegate message "FocusChanged" to hook.
  inherited;
  HookFocusedChanged;
end;

{$IFDEF VCL}
procedure TJvXPCustomControl.CMMouseEnter(var Msg: TMessage);
begin
  // delegate message "MouseEnter" to hook.
  inherited;
  HookMouseEnter;
end;

procedure TJvXPCustomControl.CMMouseLeave(var Msg: TMessage);
begin
  // delegate message "MouseLeave" to hook.
  inherited;
  HookMouseLeave;
end;

procedure TJvXPCustomControl.CMParentColorChanged(var Msg: TMessage);
begin
  // delegate message "ParentColorChanged" to hook.
  inherited;
  HookParentColorChanged;
end;

procedure TJvXPCustomControl.CMParentFontChanged(var Msg: TMessage);
begin
  // delegate message "ParentFontChanged" to hook.
  inherited;
  HookParentFontChanged;
end;

procedure TJvXPCustomControl.CMTextChanged(var Msg: TMessage);
begin
  // delegate message "TextChanged" to hook.
  inherited;
  HookTextChanged;
end;

procedure TJvXPCustomControl.WMMouseMove(var Msg: TWMMouse);
begin
  // delegate message "MouseMove" to hook.
  inherited;
  HookMouseMove(Msg.XPos, Msg.YPos);
end;

procedure TJvXPCustomControl.WMSize(var Msg: TWMSize);
begin
  // delegate message "Size" to hook.
  inherited;
  HookResized;
end;

procedure TJvXPCustomControl.WMWindowPosChanged(var Msg: TWMWindowPosChanged);
begin
  // delegate message "WindowPosChanged" to hook.
  inherited;
  HookPosChanged;
end;

{$ENDIF VCL}

{$IFDEF VisualCLX}

function TJvXPCustomControl.WantKey(Key: Integer; Shift: TShiftState;
  const KeyText: WideString): Boolean;
begin
  Result := IsAccel(Key, Caption) and Enabled and not (ssCtrl in Shift);
  if Result then
    Click
  else
    Result := inherited WantKey(Key, Shift, KeyText);
end;

procedure TJvXPCustomControl.Loaded;
begin
  inherited Loaded;
  AdjustSize;
end;

procedure TJvXPCustomControl.BorderChanged;
begin
  // delegate message "BorderChanged" to hook.
//  inherited BorderChanged;
  HookBorderChanged;
end;

procedure TJvXPCustomControl.EnabledChanged;
begin
  // delegate message "EnabledChanged" to hook.
  inherited EnabledChanged;
  HookEnabledChanged;
end;

procedure TJvXPCustomControl.MouseEnter(AControl: TControl);
begin
  // delegate message "MouseEnter" to hook.
  inherited MouseEnter(AControl);
  HookMouseEnter;
end;

procedure TJvXPCustomControl.MouseLeave(AControl: TControl);
begin
  // delegate message "MouseLeave" to hook.
  inherited MouseLeave(AControl);
  HookMouseLeave;
end;

procedure TJvXPCustomControl.ParentColorChanged;
begin
  // delegate message "ParentColorChanged" to hook.
  inherited ParentColorChanged;
  HookParentColorChanged;
end;

procedure TJvXPCustomControl.ParentFontChanged;
begin
  // delegate message "ParentFontChanged" to hook.
  inherited ParentFontChanged;
  HookParentFontChanged;
end;

procedure TJvXPCustomControl.TextChanged;
begin
  // delegate message "TextChanged" to hook.
  inherited TextChanged;
  HookTextChanged;
end;

procedure TJvXPCustomControl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  // delegate message "MouseMove" to hook.
  inherited MouseMove(Shift, X, Y);
  HookMouseMove(X, Y);
end;

procedure TJvXPCustomControl.AdjustSize;
begin
  // delegate message "Size" to hook.
  inherited AdjustSize;
  HookResized;
end;

(*
procedure TJvXPCustomControl.WMWindowPosChanged(var Msg: TWMWindowPosChanged);
begin
  // delegate message "WindowPosChanged" to hook.
  inherited;
  HookPosChanged;
end;
*)

{$ENDIF VisualCLX}

procedure TJvXPCustomControl.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  // delegate message "MouseDown" to hook.
  inherited MouseDown(Button, Shift, X, Y);
  if Button = mbLeft then
  begin
    FClicking := True;
    HookMouseDown;
  end;
end;

procedure TJvXPCustomControl.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  // delegate message "MouseUp" to hook.
  inherited MouseUp(Button, Shift, X, Y);
  if FClicking then
  begin
    FClicking := False;
    HookMouseUp;
  end;
end;

procedure TJvXPCustomControl.Click;
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Self);
  if Form <> nil then
    Form.ModalResult := ModalResult;
  inherited Click;
end;

//
// hooks are used to interrupt default windows messages in an easier
// way - it's possible to override them in descendant classes.
// Beware of multiple redraw calls - if you know that the calling
// hooks always redraws the component, use the lock i.e. unlock methods
// (rom) or LockedInvalidate.

procedure TJvXPCustomControl.HookBorderChanged;
begin
  // this hook is called, if the border property was changed.
  // in that case we normaly have to redraw the control.
  if csRedrawBorderChanged in ExControlStyle then