jvexcontrols.macros

East make Tray Icon in delphi

begin
  BaseWndProc(CM_SHOWINGCHANGED);
end;

procedure TJvEx##ClassName.ShowHintChanged;
begin
  BaseWndProc(CM_SHOWHINTCHANGED);
end;

{ VCL sends CM_CONTROLLISTCHANGE and CM_CONTROLCHANGE in a different order than
  the CLX methods are used. So we must correct it by evaluating "Inserting". }
procedure TJvEx##ClassName.ControlsListChanging(Control: TControl; Inserting: Boolean);
begin
  if Inserting then
    BaseWndProc(CM_CONTROLLISTCHANGE, Integer(Control), Integer(Inserting))
  else
    BaseWndProc(CM_CONTROLCHANGE, Integer(Control), Integer(Inserting));
end;

procedure TJvEx##ClassName.ControlsListChanged(Control: TControl; Inserting: Boolean);
begin
  if not Inserting then
    BaseWndProc(CM_CONTROLLISTCHANGE, Integer(Control), Integer(Inserting))
  else
    BaseWndProc(CM_CONTROLCHANGE, Integer(Control), Integer(Inserting));
end;

procedure TJvEx##ClassName.GetDlgCode(var Code: TDlgCodes);
begin
end;

procedure TJvEx##ClassName.FocusSet(PrevWnd: HWND);
begin
  BaseWndProc(WM_SETFOCUS, Integer(PrevWnd), 0);
end;

procedure TJvEx##ClassName.FocusKilled(NextWnd: HWND);
begin
  BaseWndProc(WM_KILLFOCUS, Integer(NextWnd), 0);
end;

function TJvEx##ClassName.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
begin
  Result := BaseWndProc(WM_ERASEBKGND, Canvas.Handle, Param) <> 0;
end;

{$IFDEF JVCLThemesEnabledD56}
function TJvEx##ClassName.GetParentBackground: Boolean;
begin
  Result := JvThemes.GetParentBackground(Self);
end;

procedure TJvEx##ClassName.SetParentBackground(Value: Boolean);
begin
  JvThemes.SetParentBackground(Self, Value);
end;
{$ENDIF JVCLThemesEnabledD56}
*)


// ****************** EditControl implementation *******************
(*$DEFINE EDITCONTROL_IMPL(ClassName)
WINCONTROL_IMPL(ClassName)

procedure TJvEx##ClassName.SetClipboardCommands(const Value: TJvClipboardCommands);
begin
  FClipboardCommands := Value;
end;
*)

// *********************************************************************
// *********************************************************************

// ****************** Control WndProc implementation *******************
(*$DEFINE CONTROL_WNDPROC_CASES
    CM_DENYSUBCLASSING:
      Msg.Result := Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil);
    CM_DIALOGCHAR:
      with TCMDialogChar(Msg) do
        Result := Ord(WantKey(CharCode, KeyDataToShiftState(KeyData), WideChar(CharCode)));
    CM_HINTSHOW:
      with TCMHintShow(Msg) do
        Result := Integer(HintShow(HintInfo^));
    CM_HITTEST:
      with TCMHitTest(Msg) do
        Result := Integer(HitTest(XPos, YPos));
    CM_MOUSEENTER:
      MouseEnter(TControl(Msg.LParam));
    CM_MOUSELEAVE:
      MouseLeave(TControl(Msg.LParam));
    CM_VISIBLECHANGED:
      VisibleChanged;
    CM_ENABLEDCHANGED:
      EnabledChanged;
    CM_TEXTCHANGED:
      TextChanged;
    CM_FONTCHANGED:
      FontChanged;
    CM_COLORCHANGED:
      ColorChanged;
    CM_FOCUSCHANGED:
      FocusChanged(TWinControl(Msg.LParam));
    CM_PARENTFONTCHANGED:
      ParentFontChanged;
    CM_PARENTCOLORCHANGED:
      ParentColorChanged;
    CM_PARENTSHOWHINTCHANGED:
      ParentShowHintChanged;
*)

(*$DEFINE CONTROL_WNDPROC(ClassName)
procedure TJvEx##ClassName.WndProc(var Msg: TMessage);
begin
  case Msg.Msg of
    CONTROL_WNDPROC_CASES
  else
    inherited WndProc(Msg);
  end;
end;
*)

// ****************** WinControl WndProc implementation *******************
(*$DEFINE WINCONTROL_WNDPROC_CASES
    CONTROL_WNDPROC_CASES
    CM_CURSORCHANGED:
      CursorChanged;
    CM_SHOWINGCHANGED:
      ShowingChanged;
    CM_SHOWHINTCHANGED:
      ShowHintChanged;
    CM_CONTROLLISTCHANGE:
      if Msg.LParam <> 0 then
        ControlsListChanging(TControl(Msg.WParam), True)
      else
        ControlsListChanged(TControl(Msg.WParam), False);
    CM_CONTROLCHANGE:
      if Msg.LParam = 0 then
        ControlsListChanging(TControl(Msg.WParam), False)
      else
        ControlsListChanged(TControl(Msg.WParam), True);
    WM_SETFOCUS:
      FocusSet(HWND(Msg.WParam));
    WM_KILLFOCUS:
      FocusKilled(HWND(Msg.WParam));
    WM_SIZE:
      begin
        inherited WndProc(Msg);
        BoundsChanged;
      end;
    WM_ERASEBKGND:
      begin
        IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against Stock-Objects from Canvas
        Canvas := TCanvas.Create;
        try
          Canvas.Handle := HDC(Msg.WParam);
          Msg.Result := Ord(DoEraseBackground(Canvas, Msg.LParam));
        finally
          Canvas.Handle := 0;
          Canvas.Free;
          RestoreDC(HDC(Msg.WParam), IdSaveDC);
        end;
      end;
    WM_PRINTCLIENT, WM_PRINT: // VCL bug fix
      begin
        IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against changes
        try
          inherited WndProc(Msg);
        finally
          RestoreDC(HDC(Msg.WParam), IdSaveDC);
        end;
      end;
    WM_GETDLGCODE:
      begin
        inherited WndProc(Msg);
        DlgCodes := [dcNative] + DlgcToDlgCodes(Msg.Result);
        GetDlgCode(DlgCodes);
        if not (dcNative in DlgCodes) then
          Msg.Result := DlgCodesToDlgc(DlgCodes);
      end;
*)

(*$DEFINE WINCONTROL_WNDPROC(ClassName)
procedure TJvEx##ClassName.WndProc(var Msg: TMessage);
var
  IdSaveDC: Integer;
  DlgCodes: TDlgCodes;
  Canvas: TCanvas;
begin
  case Msg.Msg of
    WINCONTROL_WNDPROC_CASES
  else
    inherited WndProc(Msg);
  end;
end;
*)

// ****************** EditControl WndProc implementation *******************
(*$DEFINE EDITCONTROL_WNDPROC_CASES
    WINCONTROL_WNDPROC_CASES
    WM_CLEAR:
      if caClear in ClipboardCommands then
        inherited WndProc(Msg)
      else
        Msg.Result := 1;
    WM_UNDO, EM_UNDO:
      if caUndo in ClipboardCommands then
        inherited WndProc(Msg)
      else
        Msg.Result := 1;
    WM_COPY:
      if caCopy in ClipboardCommands then
        inherited WndProc(Msg)
      else
        Msg.Result := 1;
    WM_CUT:
      if caCut in ClipboardCommands then
        inherited WndProc(Msg)
      else
        Msg.Result := 1;
    WM_PASTE:
      if caPaste in ClipboardCommands then
        inherited WndProc(Msg)
      else
        Msg.Result := 1;
*)

(*$DEFINE EDITCONTROL_WNDPROC(ClassName)
procedure TJvEx##ClassName.WndProc(var Msg: TMessage);
var
  IdSaveDC: Integer;
  DlgCodes: TDlgCodes;
  Canvas: TCanvas;
begin
  case Msg.Msg of
    EDITCONTROL_WNDPROC_CASES
  else
    inherited WndProc(Msg);
  end;
end;
*)

// *************************************************************************
// *************************************************************************

// ****************** Default-Helpers ********************

(*$DEFINE CONTROL_IMPL_DEFAULT(ClassName)
BEGIN_CONTROL_CONSTRUCTOR(ClassName)
END_CONSTRUCTOR

CONTROL_IMPL(ClassName)

CONTROL_WNDPROC(ClassName)

//============================================================================

*)

(*$DEFINE WINCONTROL_IMPL_DEFAULT(ClassName)
BEGIN_WINCONTROL_CONSTRUCTOR(ClassName)
END_CONSTRUCTOR

WINCONTROL_IMPL(ClassName)

WINCONTROL_WNDPROC(ClassName)

//============================================================================

*)

(*$DEFINE EDITCONTROL_IMPL_DEFAULT(ClassName)
BEGIN_EDITCONTROL_CONSTRUCTOR(ClassName)
END_CONSTRUCTOR

EDITCONTROL_IMPL(ClassName)

EDITCONTROL_WNDPROC(ClassName)

//============================================================================

*)