jvqexextctrls.pas

East make Tray Icon in delphi

    FOnEvent: TEventEvent;
    procedure DoOnFontChanged(Sender: TObject);
    procedure CMDesignHitTest(var Mesg: TJvMessage); message CM_DESIGNHITTEST;
  protected
    procedure CreateWidget; override;
    procedure CreateWnd; virtual;
    procedure CursorChanged; override;
    procedure DoEnter; override;
    function DoPaintBackground(Canvas: TCanvas; Param: Integer): Boolean; virtual;
    procedure DoExit; override;
    procedure DoKillFocus(NextWnd: HWND); dynamic;
    procedure DoSetFocus(PreviousWnd: HWND); dynamic;
    function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; override;
    procedure PaintWindow(PaintDevice: QPaintDeviceH);
    procedure RecreateWnd;
    procedure ShowingChanged; override;
    function WidgetFlags: Integer; override;
  public
    function ColorToRGB(Value: TColor): TColor;
    procedure PaintTo(PaintDevice: QPaintDeviceH; X, Y: Integer);
  published
    property OnEvent: TEventEvent read FOnEvent write FOnEvent;
  private
    FDoubleBuffered: Boolean;
  protected
    property DoubleBuffered: Boolean read FDoubleBuffered write FDoubleBuffered;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;
  

  { QControl begin }
  TJvExSplitter = class(TSplitter)
  { QControl }
  private
    FAboutJVCL: TJVCLAboutInfo;
    FDesktopFont: Boolean;
    FDragCursor: TCursor;
    FDragKind: TDragKind;
    FHintColor: TColor;
    FMouseOver: Boolean;
    FOnParentColorChanged: TNotifyEvent;
    FWindowProc: TWndMethod;
    procedure SetDesktopFont(Value: Boolean);
    procedure CMHitTest(var Mesg: TJvMessage); message CM_HITTEST;
    procedure CMHintShow(var Mesg: TJvMessage); message CM_HINTSHOW;
    procedure CMSysFontChanged(var Mesg: TMessage); message CM_SYSFONTCHANGED;
  protected
    procedure ColorChanged; override;
    procedure EnabledChanged; override;
    procedure FocusChanged; dynamic;
    function HitTest(X, Y: integer): Boolean; override;
    procedure MouseEnter(AControl: TControl); override;
    procedure MouseLeave(AControl: TControl); override;
    procedure ParentColorChanged; override;
    procedure TextChanged; override;
    procedure VisibleChanged; override;
    function HintShow(var HintInfo : THintInfo): Boolean; override;
    procedure WndProc(var Mesg: TMessage); dynamic;
    property DragCursor: TCursor read FDragCursor write FDragCursor stored False; { not implemented }
    property DragKind: TDragKind read FDragKind write FDragKind stored false; { not implemented }
    property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
    property DesktopFont: Boolean read FDesktopFont write SetDesktopFont default false;
  public
    procedure Dispatch(var Mesg); override;
    function Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
    function IsRightToLeft: Boolean;
    property WindowProc: TWndMethod read FWindowProc write FWindowProc;
    property MouseOver: Boolean read FMouseOver write FMouseOver;
  published
    property AboutJVCLX: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
    property HintColor: TColor read FHintColor write FHintColor default clDefault;
  private
    FText: string;
  protected
    function GetText: TCaption; override;
    procedure SetText(const Value: TCaption); override;
  protected
    procedure FontChanged; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;
  

implementation

{$IFDEF UNITVERSIONING}
uses
  JclUnitVersioning;
{$ENDIF UNITVERSIONING}

{ QControl Create }
constructor TJvExShape.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHintColor := clDefault;
  FWindowProc := WndProc;
  
end;

destructor TJvExShape.Destroy;
begin
  
  inherited Destroy;
end;
 
procedure TJvExShape.WndProc(var Mesg: TMessage);
begin
  //OutputDebugString(PAnsiChar(Format('JV_CONTROL %s: %s Msg $%x',[Name, ClassName, Mesg.Msg])));
  with TJvMessage(Mesg) do
  begin
    case Msg of
      { Control Messages }
      CM_FOCUSCHANGED: FocusChanged;
      CM_MOUSEENTER: FMouseOver := True;
      CM_MOUSELEAVE: FMouseOver := False;
      CM_HINTSHOW:
        case FHintColor of
          clNone   : HintInfo^.HintColor := Application.HintColor;
          clDefault: HintInfo^.HintColor := GetHintColor(Parent);
        else
          HintInfo^.HintColor := FHintcolor;
        end;

    end;
  end;
  inherited Dispatch(Mesg);
end;

procedure TJvExShape.CMHitTest(var Mesg: TJvMessage);
begin
  with Mesg do
  begin
    Handled := inherited HitTest(XPos, YPos);
    if Handled then
      Result := HTCLIENT;
  end;
end;

procedure TJvExShape.ColorChanged;
begin
  Perform(CM_COLORCHANGED, 0, 0);
  inherited ColorChanged;
end;

procedure TJvExShape.FontChanged;
begin
  Perform(CM_FONTCHANGED, 0, 0);
  inherited FontChanged;
end;

procedure TJvExShape.FocusChanged;
begin
  { notification }
end;
 
{ QControl Common}

function TJvExShape.HitTest(X, Y: integer): Boolean;
begin
   Result := Perform(CM_HITTEST, 0, 0) <> HTNOWHERE;
end;

procedure TJvExShape.CMHintShow(var Mesg: TJvMessage);
begin
  with Mesg do
  begin
    Handled := inherited HintShow(HintInfo^);
  end;
end;

procedure TJvExShape.CMSysFontChanged(var Mesg: TMessage);
begin
  if FDesktopFont then
  begin
    Font.Assign(Application.Font);
    FDesktopFont := True;
  end;
end;

procedure TJvExShape.EnabledChanged;
begin
  Perform(CM_ENABLEDCHANGED, 0, 0);
  inherited EnabledChanged;
end;

procedure TJvExShape.TextChanged;
begin
  Perform(CM_TEXTCHANGED, 0, 0);
  inherited TextChanged;
end;

procedure TJvExShape.VisibleChanged;
begin
  Perform(CM_VISIBLECHANGED, 0, 0);
  inherited VisibleChanged;
end;

function TJvExShape.HintShow(var HintInfo : THintInfo): Boolean;
begin
  Result := Perform(CM_HINTSHOW, 0, Integer(@HintInfo)) <> 0;
end;

procedure TJvExShape.MouseEnter(AControl: TControl);
begin
  Perform(CM_MOUSEENTER, 0, 0);
  inherited MouseEnter(AControl);
end;

procedure TJvExShape.MouseLeave(AControl: TControl);
begin
  Perform(CM_MOUSELEAVE, 0, 0);
  inherited MouseLeave(AControl);
end;

procedure TJvExShape.ParentColorChanged;
begin
  inherited ParentColorChanged;
  if Assigned(FOnParentColorChanged) then
    FOnParentColorChanged(Self);
end;

procedure TJvExShape.SetDesktopFont(Value: Boolean);
begin
  if FDesktopFont <> Value then
  begin
    FDesktopFont := Value;
    Perform(CM_SYSFONTCHANGED, 0, 0);
  end;
end;

procedure TJvExShape.Dispatch(var Mesg);
begin
  if Assigned(FWindowProc) then
    FWindowProc(TMessage(Mesg))
  else
    inherited Dispatch(Mesg);
end;

function TJvExShape.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
var
  Mesg: TMessage;
begin
  Mesg.Msg := Msg;
  Mesg.WParam := WParam;
  Mesg.LParam := LParam;
  Mesg.Result := 0;
  Dispatch(Mesg);
  Result := Mesg.Result;
end;

function TJvExShape.IsRightToLeft: Boolean;
begin
  Result := False;
end;
  
{ QControl Create }
constructor TJvExPaintBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHintColor := clDefault;
  FWindowProc := WndProc;
  
end;

destructor TJvExPaintBox.Destroy;
begin
  
  inherited Destroy;
end;
 
procedure TJvExPaintBox.WndProc(var Mesg: TMessage);
begin
  //OutputDebugString(PAnsiChar(Format('JV_CONTROL %s: %s Msg $%x',[Name, ClassName, Mesg.Msg])));
  with TJvMessage(Mesg) do
  begin
    case Msg of
      { Control Messages }
      CM_FOCUSCHANGED: FocusChanged;
      CM_MOUSEENTER: FMouseOver := True;
      CM_MOUSELEAVE: FMouseOver := False;
      CM_HINTSHOW:
        case FHintColor of
          clNone   : HintInfo^.HintColor := Application.HintColor;
          clDefault: HintInfo^.HintColor := GetHintColor(Parent);
        else
          HintInfo^.HintColor := FHintcolor;
        end;

    end;
  end;
  inherited Dispatch(Mesg);
end;

procedure TJvExPaintBox.CMHitTest(var Mesg: TJvMessage);
begin
  with Mesg do
  begin
    Handled := inherited HitTest(XPos, YPos);
    if Handled then
      Result := HTCLIENT;
  end;
end;

procedure TJvExPaintBox.ColorChanged;
begin
  Perform(CM_COLORCHANGED, 0, 0);
  inherited ColorChanged;
end;

procedure TJvExPaintBox.FontChanged;
begin
  Perform(CM_FONTCHANGED, 0, 0);
  inherited FontChanged;
end;

procedure TJvExPaintBox.FocusChanged;
begin
  { notification }
end;
 
{ QControl Common}

function TJvExPaintBox.HitTest(X, Y: integer): Boolean;
begin
   Result := Perform(CM_HITTEST, 0, 0) <> HTNOWHERE;
end;

procedure TJvExPaintBox.CMHintShow(var Mesg: TJvMessage);
begin
  with Mesg do
  begin
    Handled := inherited HintShow(HintInfo^);
  end;
end;

procedure TJvExPaintBox.CMSysFontChanged(var Mesg: TMessage);
begin
  if FDesktopFont then
  begin
    Font.Assign(Application.Font);
    FDesktopFont := True;
  end;
end;

procedure TJvExPaintBox.EnabledChanged;
begin
  Perform(CM_ENABLEDCHANGED, 0, 0);
  inherited EnabledChanged;
end;

procedure TJvExPaintBox.TextChanged;
begin
  Perform(CM_TEXTCHANGED, 0, 0);
  inherited TextChanged;
end;

procedure TJvExPaintBox.VisibleChanged;
begin
  Perform(CM_VISIBLECHANGED, 0, 0);
  inherited VisibleChanged;
end;

function TJvExPaintBox.HintShow(var HintInfo : THintInfo): Boolean;
begin
  Result := Perform(CM_HINTSHOW, 0, Integer(@HintInfo)) <> 0;
end;

procedure TJvExPaintBox.MouseEnter(AControl: TControl);
begin
  Perform(CM_MOUSEENTER, 0, 0);
  inherited MouseEnter(AControl);
end;

procedure TJvExPaintBox.MouseLeave(AControl: TControl);
begin
  Perform(CM_MOUSELEAVE, 0, 0);
  inherited MouseLeave(AControl);
end;

procedure TJvExPaintBox.ParentColorChanged;
begin
  inherited ParentColorChanged;
  if Assigned(FOnParentColorChanged) then
    FOnParentColorChanged(Self);
end;

procedure TJvExPaintBox.SetDesktopFont(Value: Boolean);
begin
  if FDesktopFont <> Value then
  begin
    FDesktopFont := Value;
    Perform(CM_SYSFONTCHANGED, 0, 0);
  end;
end;

procedure TJvExPaintBox.Dispatch(var Mesg);
begin
  if Assigned(FWindowProc) then
    FWindowProc(TMessage(Mesg))
  else
    inherited Dispatch(Mesg);
end;

function TJvExPaintBox.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
var
  Mesg: TMessage;
begin
  Mesg.Msg := Msg;