Evento Onclick Bloqueado no Componente
Bom dia, pessoal...
Por bastante tempo ele funcionou corretamente, porem nos ultimos dias ele bloqueou o evento OnClick.
Nao sei porque, nao fiz nada, nao mudei nada.. e simplesmente nao consigo mais acessar o evento onclick.
Com o tab, eu consigo entrar mas nunca com o mouse, e ele funciona normalmente, eu tentei forçar o drop down e up, e funciona normal...
Forcei com esses comandos:
Abaixo esta o código do componente, por favor, me ajudem a descobrir o que ta acontecendo e onde pode estar o problema.
Se necessario envio o arquivo para testes.
Obrigada.
//=========================================================================
// EnhComboBox, ImgComboBox Components for Delphi 4
// Author: Norbert ADAMKO
// e-mail: norris@frdsa.utc.sk
// Copyright 1999
//
// Version 1.5, 25 April 1999
//
// For details and credits see ImgCBox.txt
//=========================================================================
unit DateTimebyMi2;
interface
uses
SysUtils, ComCtrls, Windows, Messages, Classes, Forms, Controls, Graphics,
StdCtrls, ImgList, Dialogs;
type
TEnhComboState = set of (csButtonPressed, csMousePressed);
TDateTimeStyle = (csDropDown, csSimple, csDropDownList, csOwnerDrawFixed,csOwnerDrawVariable);
TCustomEnhDateTime = class(TDateTimePicker)
private
FOldColor: TColor;
FOldParentColor: boolean;
FButtonWidth: integer;
FEditState: TEnhComboState;
FMouseInControl: boolean;
FAlwaysShowBorder: boolean;
FAutoDropDownWidth: boolean;
FAutoHorizontalScroll: boolean;
FButtonStaysPushed: boolean;
FExtendedInterface: boolean;
FFlat: boolean;
FBorderColor : TColor;
FDisabledColor : TColor;
FShowBorderWhenInactive: boolean;
FToolTip: boolean;
FOnCloseUp: TNotifyEvent;
FStyle: TDateTimeStyle;
procedure DateTimeByMiClick(Sender: TObject);
procedure SetStyle(const Value: TDateTimeStyle); virtual;
procedure SetFlat(const Value: boolean);
procedure SetBorderColor(const Value: TColor);
procedure SetDisabledColor(const Value: TColor);
procedure SetExUI(const Value: boolean);
function GetExUI: boolean;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
procedure WMLButtonDown(var Message: TWMMouse); message WM_LBUTTONDOWN;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure TrackButtonPressed(X, Y: integer);
function InsideCombo(X,Y: integer): boolean;
function NeedDraw3DBorder: boolean;
procedure DrawButton(DC: HDC);
procedure DrawButtonBorder(DC: HDC);
procedure DrawControlBorder(DC: HDC);
procedure DrawBorders;
procedure SetAutoDropDownWidth(const Value: boolean);
procedure SetAutoHorizontalScroll(const Value: boolean);
procedure SetAlwaysShowBorder(const Value: boolean);
protected
procedure DoCloseUp; dynamic;
function ItemSize(paDC: hDC; paIndex: Integer; paInEdit: boolean): TSize; virtual;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DestroyWnd; 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 DropDown;
property AlwaysShowBorder: boolean read FAlwaysShowBorder write SetAlwaysShowBorder default false;
property AutoDropDownWidth: boolean read FAutoDropDownWidth write SetAutoDropDownWidth default false;
property AutoHorizontalScroll: boolean read FAutoHorizontalScroll write SetAutoHorizontalScroll default false;
property ButtonStaysPushed: boolean read FButtonStaysPushed write FButtonStaysPushed default false;
property ExtendedInterface: boolean read GetExUI write SetExUI default false;
property Flat: boolean read FFlat write SetFlat default true;
property BorderColor : TColor read FBorderColor write SetBorderColor;
property DisabledColor : TColor read FDisabledColor write SetDisabledColor;
property ShowBorderWhenInactive: boolean read FShowBorderWhenInactive write FShowBorderWhenInactive default false;
property ToolTip: boolean read FToolTip write FToolTip default false;
property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
property Style: TDateTimeStyle read FStyle write SetStyle default csDropDown;
public
constructor Create(AOwner: TComponent); override;
end;
TDateTimeByMi2 = class(TCustomEnhDateTime)
published
property Style; //Must be first
property Flat;
property BorderColor;
property DisabledColor;
property AlwaysShowBorder;
{$IFDEF VER120}
property Anchors;
property AutoDropDownWidth;
property AutoHorizontalScroll;
property BiDiMode;
property ButtonStaysPushed;
property Constraints;
{$ENDIF}
property Color;
property Ctl3D;
property DragCursor;
{$IFDEF VER120}
property DragKind;
{$ENDIF}
property DragMode;
// property DropDownCount;
property Enabled;
property ExtendedInterface;
property Font;
{$IFNDEF VER90}
property ImeMode;
property ImeName;
{$ENDIF}
// property ItemHeight;
// property ItemIndex;
// property Items;
// property MaxLength;
{$IFDEF VER120}
property ParentBiDiMode;
{$ENDIF}
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowBorderWhenInactive;
property ShowHint;
// property Sorted;
property TabOrder;
property TabStop;
property Text;
property Tooltip;
property Visible;
// property OnChange;
property OnCloseUp;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
// property OnDrawItem;
// property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
// property OnMeasureItem;
property OnStartDrag;
{$IFDEF VER120}
property OnEndDock;
property OnStartDock;
{$ENDIF}
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents(byMi, [TDateTimeByMi2]);
end;
{ TCustomEnhDateTime }
//------------------------------------------------------------------------------
constructor TCustomEnhDateTime.Create(AOwner: TComponent);
begin
inherited;
FAlwaysShowBorder := False;
FAutoDropDownWidth := False;
FAutoHorizontalScroll := False;
FButtonWidth := GetSystemMetrics(SM_CXVSCROLL) + 1;
FFlat := True;
FButtonStaysPushed := False;
FShowBorderWhenInactive := False;
FOldColor := Color;
FOldParentColor := ParentColor;
FToolTip := False;
FBorderColor := TColor($00CFCFCF);
FDisabledColor := clWhite;
Style := csDropDownList;
Self.ControlStyle := Self.ControlStyle + [csClickEvents];
TForm(Self).OnClick := DateTimeByMiClick;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CMEnabledChanged(var Msg: TMessage);
begin
if FFlat then
if Enabled then begin
Color := FOldColor;
ParentColor := false;
end
else begin
FOldParentColor := ParentColor;
FOldColor := Color;
Color := FDisabledColor;
ParentColor := false;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CMEnter(var Message: TCMEnter);
begin
if not (csDesigning in ComponentState) then DrawBorders;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CMExit(var Message: TCMExit);
begin
inherited;
if not (csDesigning in ComponentState) then begin
FMouseInControl := false;
DrawBorders;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CNCommand(var Message: TWMCommand);
begin
case Message.NotifyCode of
CBN_CLOSEUP:
begin
Exclude(FEditState, csButtonPressed);
TrackButtonPressed(-1, -1);
DoCloseUp;
end;
CBN_KILLFOCUS:
begin
end;
CBN_SETFOCUS:
begin
end;
end;
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
Style := Style or WS_HSCROLL;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CreateWnd;
begin
inherited CreateWnd;
ExtendedInterface := FExtendedInterface;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DateTimeByMiClick(Sender: TObject);
begin
ShowMessage(\o//);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DestroyWnd;
begin
FExtendedInterface := ExtendedInterface;
inherited DestroyWnd;
end;
//--- Message Handlers-------------------------------------------------------
procedure TCustomEnhDateTime.DoCloseUp;
begin
if Assigned(FOnCloseUp) then FOnCloseUp(Self);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawBorders;
var DC: HDC;
begin
if (FFlat) then begin
DC := GetWindowDC(Handle);
try
DrawControlBorder(DC);
DrawButtonBorder(DC);
finally
ReleaseDC(Handle, DC);
end;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawButton(DC: HDC);
var HelpRect: TRect;
begin
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
Inc(HelpRect.Left, ClientWidth - FButtonWidth);
DrawFrameControl(DC, HelpRect, DFC_SCROLL, DFCS_SCROLLCOMBOBOX or DFCS_FLAT);
ExcludeClipRect(DC, ClientWidth - FButtonWidth - 1, 0, ClientWidth, ClientHeight);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawButtonBorder(DC: HDC);
var HelpRect, HelpRect2: TRect;
BtnFaceBrush: HBRUSH;
begin
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
Inc(HelpRect.Left, ClientWidth - FButtonWidth - 2);
InflateRect(HelpRect, -2, -2);
BtnFaceBrush := CreateSolidBrush(FBorderColor);
try
//Clear the line to the left of the button
InflateRect(HelpRect, -1, -1);
HelpRect2 := HelpRect;
with HelpRect2 do
begin
Right := Left + 2;
Dec(Left, 2);
FillRect(DC, HelpRect2, Brush.Handle);
end;
//Gray out the region
Inc(HelpRect.Left, 1);
FillRect(DC, HelpRect, BtnFaceBrush);
finally
DeleteObject(BtnFaceBrush);
end;
//Clip the borders, so we can paint the button with arrow
IntersectClipRect(DC, HelpRect.Left {+ 2}, HelpRect.Top {+ 1},
HelpRect.Right {- 1}, HelpRect.Bottom {- 1});
DrawButton(DC);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawControlBorder(DC: HDC);
var HelpRect: TRect;
BtnFaceBrush, WindowBrush: HBRUSH;
begin
BtnFaceBrush := CreateSolidBrush(BorderColor);
WindowBrush := CreateSolidBrush(GetSysColor(COLOR_WINDOW));
WindowBrush := CreateSolidBrush(clWhite);
try
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
FrameRect(DC, HelpRect, BtnFaceBrush);
InflateRect(HelpRect, -1, -1);
FrameRect(DC, HelpRect, BtnFaceBrush);
InflateRect(HelpRect, -1, -1);
FrameRect(DC, HelpRect, WindowBrush);
finally
DeleteObject(WindowBrush);
DeleteObject(BtnFaceBrush);
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DropDown;
var DC: HDC;
OldFont: HFONT;
Size: TSize;
MaxLen, i: integer;
begin
inherited;
if FAutoHorizontalScroll or FAutoDropDownWidth then begin
DC := CreateCompatibleDC(0);
OldFont := SelectObject(DC, Font.Handle);
MaxLen := 0;
// try
// for i:=0 to Items.Count-1 do begin
// Size := ItemSize(DC, i, false);
// if Size.cx>MaxLen then MaxLen := Size.cx;
// end;
// finally
// SelectObject(DC, OldFont);
// DeleteDC(DC);
// end;
//
// if FAutoDropDownWidth then
// if Items.Count>DropDownCount then
// else
end;
end;
//------------------------------------------------------------------------------
function TCustomEnhDateTime.GetExUI: boolean;
begin
Result := boolean(Perform(CB_GETEXTENDEDUI, 0, 0));
end;
//Check if the mouse is in ComboBox area
//------------------------------------------------------------------------------
function TCustomEnhDateTime.InsideCombo(X, Y: integer): boolean;
begin
Result := PtInRect(Rect(0, 0, Width, Height), Point(X, Y));
end;
//---Help Routines----------------------------------------------------------
function TCustomEnhDateTime.ItemSize(paDC: hDC; paIndex: Integer;
paInEdit: boolean): TSize;
var DC: HDC;
OldFont: HFONT;
begin
if paIndex=-1 then begin
Result.cx := 0;
Result.cy := 0;
end
else begin
if paDC=0 then begin
DC := CreateCompatibleDC(0);
OldFont := SelectObject(DC, Font.Handle);
end
else begin
DC := paDC;
OldFont := 0;
end;
try
// GetTextExtentPoint32(DC, PChar(Items[paIndex]), Length(Items[paIndex]), Result);
finally
if paDC=0 then begin
SelectObject(DC, OldFont);
DeleteDC(DC);
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: integer);
begin
SendMessage(Handle,WM_SYSKEYDOWN,VK_DOWN, 0);
// if DroppedDown then begin
MouseCapture := true;
Include(FEditState, csMousePressed);
// end;
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.MouseMove(Shift: TShiftState; X, Y: integer);
begin
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: integer);
begin
MouseCapture := false;
if not FButtonStaysPushed then
begin
Exclude(FEditState, csMousePressed);
TrackButtonPressed(-1, -1);
end;
inherited;
end;
//------------------------------------------------------------------------------
function TCustomEnhDateTime.NeedDraw3DBorder: boolean;
begin
if csDesigning in ComponentState then
Result := Enabled
else
Result := FAlwaysShowBorder or
((FMouseInControl or (Screen.ActiveControl = Self)) and
(ShowBorderWhenInactive or Application.Active));
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetAlwaysShowBorder(const Value: boolean);
begin
if FAlwaysShowBorder <> Value then begin
FAlwaysShowBorder := Value;
Invalidate;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetAutoDropDownWidth(const Value: boolean);
begin
FAutoDropDownWidth := Value;
if FAutoDropDownWidth then FAutoHorizontalScroll := false;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetAutoHorizontalScroll(const Value: boolean);
begin
FAutoHorizontalScroll := Value;
if FAutoHorizontalScroll then FAutoDropDownWidth := false;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetBorderColor(const Value: TColor);
begin
if Value <> FBorderColor then begin
FBorderColor := Value;
DrawBorders;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetDisabledColor(const Value: TColor);
var
msg: TMessage;
begin
if Value <> FDisabledColor then begin
FDisabledColor := Value;
CMEnabledChanged(msg);
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetExUI(const Value: boolean);
begin
Perform(CB_SETEXTENDEDUI, integer(Value), 0);
FExtendedInterface := ExtendedInterface;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetFlat(const Value: boolean);
begin
if Value <> FFlat then begin
FFlat := Value;
Ctl3D := not Value;
Invalidate;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetStyle(const Value: TDateTimeStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
if Value = csSimple then
ControlStyle := ControlStyle - [csFixedHeight] else
ControlStyle := ControlStyle + [csFixedHeight];
RecreateWnd;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.TrackButtonPressed(X, Y: integer);
var HelpRect: TRect;
Pressed: boolean;
begin
SetRect(HelpRect, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
Pressed := csButtonPressed in FEditState;
if PtInRect(HelpRect, Point(X, Y)) or (Pressed and FButtonStaysPushed) then
begin
Include(FEditState, csButtonPressed);
// if not Pressed then DrawBorders; //Paint only if state was changed
end
else
begin
Exclude(FEditState, csButtonPressed);
// if Pressed or FButtonStaysPushed then DrawBorders;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.WMLButtonDown(var Message: TWMMouse);
begin
//Uncapture the mouse - ComboBox is focused now
//Mouse was captured when entering ComboBox
//We should set the csButtonPressed here - before Delphi drops down the combo
//This makes the button look like it is being pushed down
MouseCapture := false;
if (Style>csDropDown) then
Include(FEditState, csButtonPressed) //Button should go down even when clicked in edit control
else
TrackButtonPressed(Message.Pos.X, Message.Pos.Y);
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.WMPaint(var Message: TWMPaint);
var DC: HDC;
PS: TPaintStruct;
HelpRect: TRect;
begin
if (not FFlat) then
inherited
else
begin
if Message.DC=0 then DC := BeginPaint(Handle, PS)
else DC := Message.DC;
try
if Style<>csSimple then
begin
//Clip the region - do not let windows paint in border and button areas
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
InflateRect(HelpRect, -2, -2);
Dec(HelpRect.Right, FButtonWidth-1);
IntersectClipRect(DC, HelpRect.Left, HelpRect.Top, HelpRect.Right, HelpRect.Bottom);
end;
//Paint Windows Control
PaintWindow(DC);
finally
if Message.DC=0 then EndPaint(Handle, PS);
end;
//Make Combo look flat
DrawBorders;
end;
end;
//------------------------------------------------------------------------------
end.
Por bastante tempo ele funcionou corretamente, porem nos ultimos dias ele bloqueou o evento OnClick.
Nao sei porque, nao fiz nada, nao mudei nada.. e simplesmente nao consigo mais acessar o evento onclick.
Com o tab, eu consigo entrar mas nunca com o mouse, e ele funciona normalmente, eu tentei forçar o drop down e up, e funciona normal...
Forcei com esses comandos:
DateTimePicker1.Perform(WM_KEYDOWN, VK_F4, 0); DateTimePicker1.Perform(WM_KEYUP, VK_F4, 0);
Abaixo esta o código do componente, por favor, me ajudem a descobrir o que ta acontecendo e onde pode estar o problema.
Se necessario envio o arquivo para testes.
Obrigada.
//=========================================================================
// EnhComboBox, ImgComboBox Components for Delphi 4
// Author: Norbert ADAMKO
// e-mail: norris@frdsa.utc.sk
// Copyright 1999
//
// Version 1.5, 25 April 1999
//
// For details and credits see ImgCBox.txt
//=========================================================================
unit DateTimebyMi2;
interface
uses
SysUtils, ComCtrls, Windows, Messages, Classes, Forms, Controls, Graphics,
StdCtrls, ImgList, Dialogs;
type
TEnhComboState = set of (csButtonPressed, csMousePressed);
TDateTimeStyle = (csDropDown, csSimple, csDropDownList, csOwnerDrawFixed,csOwnerDrawVariable);
TCustomEnhDateTime = class(TDateTimePicker)
private
FOldColor: TColor;
FOldParentColor: boolean;
FButtonWidth: integer;
FEditState: TEnhComboState;
FMouseInControl: boolean;
FAlwaysShowBorder: boolean;
FAutoDropDownWidth: boolean;
FAutoHorizontalScroll: boolean;
FButtonStaysPushed: boolean;
FExtendedInterface: boolean;
FFlat: boolean;
FBorderColor : TColor;
FDisabledColor : TColor;
FShowBorderWhenInactive: boolean;
FToolTip: boolean;
FOnCloseUp: TNotifyEvent;
FStyle: TDateTimeStyle;
procedure DateTimeByMiClick(Sender: TObject);
procedure SetStyle(const Value: TDateTimeStyle); virtual;
procedure SetFlat(const Value: boolean);
procedure SetBorderColor(const Value: TColor);
procedure SetDisabledColor(const Value: TColor);
procedure SetExUI(const Value: boolean);
function GetExUI: boolean;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
procedure WMLButtonDown(var Message: TWMMouse); message WM_LBUTTONDOWN;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure TrackButtonPressed(X, Y: integer);
function InsideCombo(X,Y: integer): boolean;
function NeedDraw3DBorder: boolean;
procedure DrawButton(DC: HDC);
procedure DrawButtonBorder(DC: HDC);
procedure DrawControlBorder(DC: HDC);
procedure DrawBorders;
procedure SetAutoDropDownWidth(const Value: boolean);
procedure SetAutoHorizontalScroll(const Value: boolean);
procedure SetAlwaysShowBorder(const Value: boolean);
protected
procedure DoCloseUp; dynamic;
function ItemSize(paDC: hDC; paIndex: Integer; paInEdit: boolean): TSize; virtual;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DestroyWnd; 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 DropDown;
property AlwaysShowBorder: boolean read FAlwaysShowBorder write SetAlwaysShowBorder default false;
property AutoDropDownWidth: boolean read FAutoDropDownWidth write SetAutoDropDownWidth default false;
property AutoHorizontalScroll: boolean read FAutoHorizontalScroll write SetAutoHorizontalScroll default false;
property ButtonStaysPushed: boolean read FButtonStaysPushed write FButtonStaysPushed default false;
property ExtendedInterface: boolean read GetExUI write SetExUI default false;
property Flat: boolean read FFlat write SetFlat default true;
property BorderColor : TColor read FBorderColor write SetBorderColor;
property DisabledColor : TColor read FDisabledColor write SetDisabledColor;
property ShowBorderWhenInactive: boolean read FShowBorderWhenInactive write FShowBorderWhenInactive default false;
property ToolTip: boolean read FToolTip write FToolTip default false;
property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
property Style: TDateTimeStyle read FStyle write SetStyle default csDropDown;
public
constructor Create(AOwner: TComponent); override;
end;
TDateTimeByMi2 = class(TCustomEnhDateTime)
published
property Style; //Must be first
property Flat;
property BorderColor;
property DisabledColor;
property AlwaysShowBorder;
{$IFDEF VER120}
property Anchors;
property AutoDropDownWidth;
property AutoHorizontalScroll;
property BiDiMode;
property ButtonStaysPushed;
property Constraints;
{$ENDIF}
property Color;
property Ctl3D;
property DragCursor;
{$IFDEF VER120}
property DragKind;
{$ENDIF}
property DragMode;
// property DropDownCount;
property Enabled;
property ExtendedInterface;
property Font;
{$IFNDEF VER90}
property ImeMode;
property ImeName;
{$ENDIF}
// property ItemHeight;
// property ItemIndex;
// property Items;
// property MaxLength;
{$IFDEF VER120}
property ParentBiDiMode;
{$ENDIF}
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowBorderWhenInactive;
property ShowHint;
// property Sorted;
property TabOrder;
property TabStop;
property Text;
property Tooltip;
property Visible;
// property OnChange;
property OnCloseUp;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
// property OnDrawItem;
// property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
// property OnMeasureItem;
property OnStartDrag;
{$IFDEF VER120}
property OnEndDock;
property OnStartDock;
{$ENDIF}
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents(byMi, [TDateTimeByMi2]);
end;
{ TCustomEnhDateTime }
//------------------------------------------------------------------------------
constructor TCustomEnhDateTime.Create(AOwner: TComponent);
begin
inherited;
FAlwaysShowBorder := False;
FAutoDropDownWidth := False;
FAutoHorizontalScroll := False;
FButtonWidth := GetSystemMetrics(SM_CXVSCROLL) + 1;
FFlat := True;
FButtonStaysPushed := False;
FShowBorderWhenInactive := False;
FOldColor := Color;
FOldParentColor := ParentColor;
FToolTip := False;
FBorderColor := TColor($00CFCFCF);
FDisabledColor := clWhite;
Style := csDropDownList;
Self.ControlStyle := Self.ControlStyle + [csClickEvents];
TForm(Self).OnClick := DateTimeByMiClick;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CMEnabledChanged(var Msg: TMessage);
begin
if FFlat then
if Enabled then begin
Color := FOldColor;
ParentColor := false;
end
else begin
FOldParentColor := ParentColor;
FOldColor := Color;
Color := FDisabledColor;
ParentColor := false;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CMEnter(var Message: TCMEnter);
begin
if not (csDesigning in ComponentState) then DrawBorders;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CMExit(var Message: TCMExit);
begin
inherited;
if not (csDesigning in ComponentState) then begin
FMouseInControl := false;
DrawBorders;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CNCommand(var Message: TWMCommand);
begin
case Message.NotifyCode of
CBN_CLOSEUP:
begin
Exclude(FEditState, csButtonPressed);
TrackButtonPressed(-1, -1);
DoCloseUp;
end;
CBN_KILLFOCUS:
begin
end;
CBN_SETFOCUS:
begin
end;
end;
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
Style := Style or WS_HSCROLL;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CreateWnd;
begin
inherited CreateWnd;
ExtendedInterface := FExtendedInterface;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DateTimeByMiClick(Sender: TObject);
begin
ShowMessage(\o//);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DestroyWnd;
begin
FExtendedInterface := ExtendedInterface;
inherited DestroyWnd;
end;
//--- Message Handlers-------------------------------------------------------
procedure TCustomEnhDateTime.DoCloseUp;
begin
if Assigned(FOnCloseUp) then FOnCloseUp(Self);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawBorders;
var DC: HDC;
begin
if (FFlat) then begin
DC := GetWindowDC(Handle);
try
DrawControlBorder(DC);
DrawButtonBorder(DC);
finally
ReleaseDC(Handle, DC);
end;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawButton(DC: HDC);
var HelpRect: TRect;
begin
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
Inc(HelpRect.Left, ClientWidth - FButtonWidth);
DrawFrameControl(DC, HelpRect, DFC_SCROLL, DFCS_SCROLLCOMBOBOX or DFCS_FLAT);
ExcludeClipRect(DC, ClientWidth - FButtonWidth - 1, 0, ClientWidth, ClientHeight);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawButtonBorder(DC: HDC);
var HelpRect, HelpRect2: TRect;
BtnFaceBrush: HBRUSH;
begin
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
Inc(HelpRect.Left, ClientWidth - FButtonWidth - 2);
InflateRect(HelpRect, -2, -2);
BtnFaceBrush := CreateSolidBrush(FBorderColor);
try
//Clear the line to the left of the button
InflateRect(HelpRect, -1, -1);
HelpRect2 := HelpRect;
with HelpRect2 do
begin
Right := Left + 2;
Dec(Left, 2);
FillRect(DC, HelpRect2, Brush.Handle);
end;
//Gray out the region
Inc(HelpRect.Left, 1);
FillRect(DC, HelpRect, BtnFaceBrush);
finally
DeleteObject(BtnFaceBrush);
end;
//Clip the borders, so we can paint the button with arrow
IntersectClipRect(DC, HelpRect.Left {+ 2}, HelpRect.Top {+ 1},
HelpRect.Right {- 1}, HelpRect.Bottom {- 1});
DrawButton(DC);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawControlBorder(DC: HDC);
var HelpRect: TRect;
BtnFaceBrush, WindowBrush: HBRUSH;
begin
BtnFaceBrush := CreateSolidBrush(BorderColor);
WindowBrush := CreateSolidBrush(GetSysColor(COLOR_WINDOW));
WindowBrush := CreateSolidBrush(clWhite);
try
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
FrameRect(DC, HelpRect, BtnFaceBrush);
InflateRect(HelpRect, -1, -1);
FrameRect(DC, HelpRect, BtnFaceBrush);
InflateRect(HelpRect, -1, -1);
FrameRect(DC, HelpRect, WindowBrush);
finally
DeleteObject(WindowBrush);
DeleteObject(BtnFaceBrush);
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DropDown;
var DC: HDC;
OldFont: HFONT;
Size: TSize;
MaxLen, i: integer;
begin
inherited;
if FAutoHorizontalScroll or FAutoDropDownWidth then begin
DC := CreateCompatibleDC(0);
OldFont := SelectObject(DC, Font.Handle);
MaxLen := 0;
// try
// for i:=0 to Items.Count-1 do begin
// Size := ItemSize(DC, i, false);
// if Size.cx>MaxLen then MaxLen := Size.cx;
// end;
// finally
// SelectObject(DC, OldFont);
// DeleteDC(DC);
// end;
//
// if FAutoDropDownWidth then
// if Items.Count>DropDownCount then
// else
end;
end;
//------------------------------------------------------------------------------
function TCustomEnhDateTime.GetExUI: boolean;
begin
Result := boolean(Perform(CB_GETEXTENDEDUI, 0, 0));
end;
//Check if the mouse is in ComboBox area
//------------------------------------------------------------------------------
function TCustomEnhDateTime.InsideCombo(X, Y: integer): boolean;
begin
Result := PtInRect(Rect(0, 0, Width, Height), Point(X, Y));
end;
//---Help Routines----------------------------------------------------------
function TCustomEnhDateTime.ItemSize(paDC: hDC; paIndex: Integer;
paInEdit: boolean): TSize;
var DC: HDC;
OldFont: HFONT;
begin
if paIndex=-1 then begin
Result.cx := 0;
Result.cy := 0;
end
else begin
if paDC=0 then begin
DC := CreateCompatibleDC(0);
OldFont := SelectObject(DC, Font.Handle);
end
else begin
DC := paDC;
OldFont := 0;
end;
try
// GetTextExtentPoint32(DC, PChar(Items[paIndex]), Length(Items[paIndex]), Result);
finally
if paDC=0 then begin
SelectObject(DC, OldFont);
DeleteDC(DC);
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: integer);
begin
SendMessage(Handle,WM_SYSKEYDOWN,VK_DOWN, 0);
// if DroppedDown then begin
MouseCapture := true;
Include(FEditState, csMousePressed);
// end;
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.MouseMove(Shift: TShiftState; X, Y: integer);
begin
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: integer);
begin
MouseCapture := false;
if not FButtonStaysPushed then
begin
Exclude(FEditState, csMousePressed);
TrackButtonPressed(-1, -1);
end;
inherited;
end;
//------------------------------------------------------------------------------
function TCustomEnhDateTime.NeedDraw3DBorder: boolean;
begin
if csDesigning in ComponentState then
Result := Enabled
else
Result := FAlwaysShowBorder or
((FMouseInControl or (Screen.ActiveControl = Self)) and
(ShowBorderWhenInactive or Application.Active));
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetAlwaysShowBorder(const Value: boolean);
begin
if FAlwaysShowBorder <> Value then begin
FAlwaysShowBorder := Value;
Invalidate;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetAutoDropDownWidth(const Value: boolean);
begin
FAutoDropDownWidth := Value;
if FAutoDropDownWidth then FAutoHorizontalScroll := false;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetAutoHorizontalScroll(const Value: boolean);
begin
FAutoHorizontalScroll := Value;
if FAutoHorizontalScroll then FAutoDropDownWidth := false;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetBorderColor(const Value: TColor);
begin
if Value <> FBorderColor then begin
FBorderColor := Value;
DrawBorders;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetDisabledColor(const Value: TColor);
var
msg: TMessage;
begin
if Value <> FDisabledColor then begin
FDisabledColor := Value;
CMEnabledChanged(msg);
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetExUI(const Value: boolean);
begin
Perform(CB_SETEXTENDEDUI, integer(Value), 0);
FExtendedInterface := ExtendedInterface;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetFlat(const Value: boolean);
begin
if Value <> FFlat then begin
FFlat := Value;
Ctl3D := not Value;
Invalidate;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetStyle(const Value: TDateTimeStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
if Value = csSimple then
ControlStyle := ControlStyle - [csFixedHeight] else
ControlStyle := ControlStyle + [csFixedHeight];
RecreateWnd;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.TrackButtonPressed(X, Y: integer);
var HelpRect: TRect;
Pressed: boolean;
begin
SetRect(HelpRect, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
Pressed := csButtonPressed in FEditState;
if PtInRect(HelpRect, Point(X, Y)) or (Pressed and FButtonStaysPushed) then
begin
Include(FEditState, csButtonPressed);
// if not Pressed then DrawBorders; //Paint only if state was changed
end
else
begin
Exclude(FEditState, csButtonPressed);
// if Pressed or FButtonStaysPushed then DrawBorders;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.WMLButtonDown(var Message: TWMMouse);
begin
//Uncapture the mouse - ComboBox is focused now
//Mouse was captured when entering ComboBox
//We should set the csButtonPressed here - before Delphi drops down the combo
//This makes the button look like it is being pushed down
MouseCapture := false;
if (Style>csDropDown) then
Include(FEditState, csButtonPressed) //Button should go down even when clicked in edit control
else
TrackButtonPressed(Message.Pos.X, Message.Pos.Y);
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.WMPaint(var Message: TWMPaint);
var DC: HDC;
PS: TPaintStruct;
HelpRect: TRect;
begin
if (not FFlat) then
inherited
else
begin
if Message.DC=0 then DC := BeginPaint(Handle, PS)
else DC := Message.DC;
try
if Style<>csSimple then
begin
//Clip the region - do not let windows paint in border and button areas
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
InflateRect(HelpRect, -2, -2);
Dec(HelpRect.Right, FButtonWidth-1);
IntersectClipRect(DC, HelpRect.Left, HelpRect.Top, HelpRect.Right, HelpRect.Bottom);
end;
//Paint Windows Control
PaintWindow(DC);
finally
if Message.DC=0 then EndPaint(Handle, PS);
end;
//Make Combo look flat
DrawBorders;
end;
end;
//------------------------------------------------------------------------------
end.
Michelli Moya
Curtidas 0
Respostas
Michelli Moya
28/11/2011
Pessoal, eu tinha descrito melhor no inicio do post, mas acho q bati a mao nessa porcaria de touchpad e apagou...
Vou descrever novamente:
Este é um DateTimePicker que foi modificado para ter aparencia flat e tambem cores diferentes. Entao é desenhado em cima o retangulo e o botaozinho com a setinha para ter essa aparencia. Foi herdado do DateTimePicker da mesma forma que foi feito num Combobox, que eu peguei como exemplo. Eu nao entendo muito bem o que tudo isso faz, eu so copiei e fui tentando fazer funcionar, e no fim consegui, mas agora parou de funcionar o evento ONCLICK e eu nao consigo achar o motivo...
Nao sei porque, nao fiz nada, nao mudei nada.. e simplesmente nao consigo mais acessar o evento onclick.
Com o tab, eu consigo entrar mas nunca com o mouse, e ele funciona normalmente, eu tentei forçar o drop down e up, e funciona normal...
Forcei com esses comandos:
Abaixo esta o código do componente, por favor, me ajudem a descobrir o que ta acontecendo e onde pode estar o problema.
Se necessario envio o arquivo para testes.
Obrigada.
Obrigada :)
Michelli
Vou descrever novamente:
Este é um DateTimePicker que foi modificado para ter aparencia flat e tambem cores diferentes. Entao é desenhado em cima o retangulo e o botaozinho com a setinha para ter essa aparencia. Foi herdado do DateTimePicker da mesma forma que foi feito num Combobox, que eu peguei como exemplo. Eu nao entendo muito bem o que tudo isso faz, eu so copiei e fui tentando fazer funcionar, e no fim consegui, mas agora parou de funcionar o evento ONCLICK e eu nao consigo achar o motivo...
Nao sei porque, nao fiz nada, nao mudei nada.. e simplesmente nao consigo mais acessar o evento onclick.
Com o tab, eu consigo entrar mas nunca com o mouse, e ele funciona normalmente, eu tentei forçar o drop down e up, e funciona normal...
Forcei com esses comandos:
DateTimePicker1.Perform(WM_KEYDOWN, VK_F4, 0); DateTimePicker1.Perform(WM_KEYUP, VK_F4, 0);
Abaixo esta o código do componente, por favor, me ajudem a descobrir o que ta acontecendo e onde pode estar o problema.
Se necessario envio o arquivo para testes.
Obrigada.
//=========================================================================
// EnhComboBox, ImgComboBox Components for Delphi 4
// Author: Norbert ADAMKO
// e-mail: norris@frdsa.utc.sk
// Copyright 1999
//
// Version 1.5, 25 April 1999
//
// For details and credits see ImgCBox.txt
//=========================================================================
unit DateTimebyMi2;
interface
uses
SysUtils, ComCtrls, Windows, Messages, Classes, Forms, Controls, Graphics,
StdCtrls, ImgList, Dialogs;
type
TEnhComboState = set of (csButtonPressed, csMousePressed);
TDateTimeStyle = (csDropDown, csSimple, csDropDownList, csOwnerDrawFixed,csOwnerDrawVariable);
TCustomEnhDateTime = class(TDateTimePicker)
private
FOldColor: TColor;
FOldParentColor: boolean;
FButtonWidth: integer;
FEditState: TEnhComboState;
FMouseInControl: boolean;
FAlwaysShowBorder: boolean;
FAutoDropDownWidth: boolean;
FAutoHorizontalScroll: boolean;
FButtonStaysPushed: boolean;
FExtendedInterface: boolean;
FFlat: boolean;
FBorderColor : TColor;
FDisabledColor : TColor;
FShowBorderWhenInactive: boolean;
FToolTip: boolean;
FOnCloseUp: TNotifyEvent;
FStyle: TDateTimeStyle;
procedure DateTimeByMiClick(Sender: TObject);
procedure SetStyle(const Value: TDateTimeStyle); virtual;
procedure SetFlat(const Value: boolean);
procedure SetBorderColor(const Value: TColor);
procedure SetDisabledColor(const Value: TColor);
procedure SetExUI(const Value: boolean);
function GetExUI: boolean;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
procedure WMLButtonDown(var Message: TWMMouse); message WM_LBUTTONDOWN;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure TrackButtonPressed(X, Y: integer);
function InsideCombo(X,Y: integer): boolean;
function NeedDraw3DBorder: boolean;
procedure DrawButton(DC: HDC);
procedure DrawButtonBorder(DC: HDC);
procedure DrawControlBorder(DC: HDC);
procedure DrawBorders;
procedure SetAutoDropDownWidth(const Value: boolean);
procedure SetAutoHorizontalScroll(const Value: boolean);
procedure SetAlwaysShowBorder(const Value: boolean);
protected
procedure DoCloseUp; dynamic;
function ItemSize(paDC: hDC; paIndex: Integer; paInEdit: boolean): TSize; virtual;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DestroyWnd; 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 DropDown;
property AlwaysShowBorder: boolean read FAlwaysShowBorder write SetAlwaysShowBorder default false;
property AutoDropDownWidth: boolean read FAutoDropDownWidth write SetAutoDropDownWidth default false;
property AutoHorizontalScroll: boolean read FAutoHorizontalScroll write SetAutoHorizontalScroll default false;
property ButtonStaysPushed: boolean read FButtonStaysPushed write FButtonStaysPushed default false;
property ExtendedInterface: boolean read GetExUI write SetExUI default false;
property Flat: boolean read FFlat write SetFlat default true;
property BorderColor : TColor read FBorderColor write SetBorderColor;
property DisabledColor : TColor read FDisabledColor write SetDisabledColor;
property ShowBorderWhenInactive: boolean read FShowBorderWhenInactive write FShowBorderWhenInactive default false;
property ToolTip: boolean read FToolTip write FToolTip default false;
property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
property Style: TDateTimeStyle read FStyle write SetStyle default csDropDown;
public
constructor Create(AOwner: TComponent); override;
end;
TDateTimeByMi2 = class(TCustomEnhDateTime)
published
property Style; //Must be first
property Flat;
property BorderColor;
property DisabledColor;
property AlwaysShowBorder;
{$IFDEF VER120}
property Anchors;
property AutoDropDownWidth;
property AutoHorizontalScroll;
property BiDiMode;
property ButtonStaysPushed;
property Constraints;
{$ENDIF}
property Color;
property Ctl3D;
property DragCursor;
{$IFDEF VER120}
property DragKind;
{$ENDIF}
property DragMode;
// property DropDownCount;
property Enabled;
property ExtendedInterface;
property Font;
{$IFNDEF VER90}
property ImeMode;
property ImeName;
{$ENDIF}
// property ItemHeight;
// property ItemIndex;
// property Items;
// property MaxLength;
{$IFDEF VER120}
property ParentBiDiMode;
{$ENDIF}
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowBorderWhenInactive;
property ShowHint;
// property Sorted;
property TabOrder;
property TabStop;
property Text;
property Tooltip;
property Visible;
// property OnChange;
property OnCloseUp;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
// property OnDrawItem;
// property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
// property OnMeasureItem;
property OnStartDrag;
{$IFDEF VER120}
property OnEndDock;
property OnStartDock;
{$ENDIF}
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents(byMi, [TDateTimeByMi2]);
end;
{ TCustomEnhDateTime }
//------------------------------------------------------------------------------
constructor TCustomEnhDateTime.Create(AOwner: TComponent);
begin
inherited;
FAlwaysShowBorder := False;
FAutoDropDownWidth := False;
FAutoHorizontalScroll := False;
FButtonWidth := GetSystemMetrics(SM_CXVSCROLL) + 1;
FFlat := True;
FButtonStaysPushed := False;
FShowBorderWhenInactive := False;
FOldColor := Color;
FOldParentColor := ParentColor;
FToolTip := False;
FBorderColor := TColor($00CFCFCF);
FDisabledColor := clWhite;
Style := csDropDownList;
Self.ControlStyle := Self.ControlStyle + [csClickEvents];
TForm(Self).OnClick := DateTimeByMiClick;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CMEnabledChanged(var Msg: TMessage);
begin
if FFlat then
if Enabled then begin
Color := FOldColor;
ParentColor := false;
end
else begin
FOldParentColor := ParentColor;
FOldColor := Color;
Color := FDisabledColor;
ParentColor := false;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CMEnter(var Message: TCMEnter);
begin
if not (csDesigning in ComponentState) then DrawBorders;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CMExit(var Message: TCMExit);
begin
inherited;
if not (csDesigning in ComponentState) then begin
FMouseInControl := false;
DrawBorders;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CNCommand(var Message: TWMCommand);
begin
case Message.NotifyCode of
CBN_CLOSEUP:
begin
Exclude(FEditState, csButtonPressed);
TrackButtonPressed(-1, -1);
DoCloseUp;
end;
CBN_KILLFOCUS:
begin
end;
CBN_SETFOCUS:
begin
end;
end;
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
Style := Style or WS_HSCROLL;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CreateWnd;
begin
inherited CreateWnd;
ExtendedInterface := FExtendedInterface;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DateTimeByMiClick(Sender: TObject);
begin
ShowMessage(\o//);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DestroyWnd;
begin
FExtendedInterface := ExtendedInterface;
inherited DestroyWnd;
end;
//--- Message Handlers-------------------------------------------------------
procedure TCustomEnhDateTime.DoCloseUp;
begin
if Assigned(FOnCloseUp) then FOnCloseUp(Self);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawBorders;
var DC: HDC;
begin
if (FFlat) then begin
DC := GetWindowDC(Handle);
try
DrawControlBorder(DC);
DrawButtonBorder(DC);
finally
ReleaseDC(Handle, DC);
end;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawButton(DC: HDC);
var HelpRect: TRect;
begin
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
Inc(HelpRect.Left, ClientWidth - FButtonWidth);
DrawFrameControl(DC, HelpRect, DFC_SCROLL, DFCS_SCROLLCOMBOBOX or DFCS_FLAT);
ExcludeClipRect(DC, ClientWidth - FButtonWidth - 1, 0, ClientWidth, ClientHeight);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawButtonBorder(DC: HDC);
var HelpRect, HelpRect2: TRect;
BtnFaceBrush: HBRUSH;
begin
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
Inc(HelpRect.Left, ClientWidth - FButtonWidth - 2);
InflateRect(HelpRect, -2, -2);
BtnFaceBrush := CreateSolidBrush(FBorderColor);
try
//Clear the line to the left of the button
InflateRect(HelpRect, -1, -1);
HelpRect2 := HelpRect;
with HelpRect2 do
begin
Right := Left + 2;
Dec(Left, 2);
FillRect(DC, HelpRect2, Brush.Handle);
end;
//Gray out the region
Inc(HelpRect.Left, 1);
FillRect(DC, HelpRect, BtnFaceBrush);
finally
DeleteObject(BtnFaceBrush);
end;
//Clip the borders, so we can paint the button with arrow
IntersectClipRect(DC, HelpRect.Left {+ 2}, HelpRect.Top {+ 1},
HelpRect.Right {- 1}, HelpRect.Bottom {- 1});
DrawButton(DC);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawControlBorder(DC: HDC);
var HelpRect: TRect;
BtnFaceBrush, WindowBrush: HBRUSH;
begin
BtnFaceBrush := CreateSolidBrush(BorderColor);
WindowBrush := CreateSolidBrush(GetSysColor(COLOR_WINDOW));
WindowBrush := CreateSolidBrush(clWhite);
try
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
FrameRect(DC, HelpRect, BtnFaceBrush);
InflateRect(HelpRect, -1, -1);
FrameRect(DC, HelpRect, BtnFaceBrush);
InflateRect(HelpRect, -1, -1);
FrameRect(DC, HelpRect, WindowBrush);
finally
DeleteObject(WindowBrush);
DeleteObject(BtnFaceBrush);
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DropDown;
var DC: HDC;
OldFont: HFONT;
Size: TSize;
MaxLen, i: integer;
begin
inherited;
if FAutoHorizontalScroll or FAutoDropDownWidth then begin
DC := CreateCompatibleDC(0);
OldFont := SelectObject(DC, Font.Handle);
MaxLen := 0;
// try
// for i:=0 to Items.Count-1 do begin
// Size := ItemSize(DC, i, false);
// if Size.cx>MaxLen then MaxLen := Size.cx;
// end;
// finally
// SelectObject(DC, OldFont);
// DeleteDC(DC);
// end;
//
// if FAutoDropDownWidth then
// if Items.Count>DropDownCount then
// else
end;
end;
//------------------------------------------------------------------------------
function TCustomEnhDateTime.GetExUI: boolean;
begin
Result := boolean(Perform(CB_GETEXTENDEDUI, 0, 0));
end;
//Check if the mouse is in ComboBox area
//------------------------------------------------------------------------------
function TCustomEnhDateTime.InsideCombo(X, Y: integer): boolean;
begin
Result := PtInRect(Rect(0, 0, Width, Height), Point(X, Y));
end;
//---Help Routines----------------------------------------------------------
function TCustomEnhDateTime.ItemSize(paDC: hDC; paIndex: Integer;
paInEdit: boolean): TSize;
var DC: HDC;
OldFont: HFONT;
begin
if paIndex=-1 then begin
Result.cx := 0;
Result.cy := 0;
end
else begin
if paDC=0 then begin
DC := CreateCompatibleDC(0);
OldFont := SelectObject(DC, Font.Handle);
end
else begin
DC := paDC;
OldFont := 0;
end;
try
// GetTextExtentPoint32(DC, PChar(Items[paIndex]), Length(Items[paIndex]), Result);
finally
if paDC=0 then begin
SelectObject(DC, OldFont);
DeleteDC(DC);
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: integer);
begin
SendMessage(Handle,WM_SYSKEYDOWN,VK_DOWN, 0);
// if DroppedDown then begin
MouseCapture := true;
Include(FEditState, csMousePressed);
// end;
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.MouseMove(Shift: TShiftState; X, Y: integer);
begin
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: integer);
begin
MouseCapture := false;
if not FButtonStaysPushed then
begin
Exclude(FEditState, csMousePressed);
TrackButtonPressed(-1, -1);
end;
inherited;
end;
//------------------------------------------------------------------------------
function TCustomEnhDateTime.NeedDraw3DBorder: boolean;
begin
if csDesigning in ComponentState then
Result := Enabled
else
Result := FAlwaysShowBorder or
((FMouseInControl or (Screen.ActiveControl = Self)) and
(ShowBorderWhenInactive or Application.Active));
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetAlwaysShowBorder(const Value: boolean);
begin
if FAlwaysShowBorder <> Value then begin
FAlwaysShowBorder := Value;
Invalidate;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetAutoDropDownWidth(const Value: boolean);
begin
FAutoDropDownWidth := Value;
if FAutoDropDownWidth then FAutoHorizontalScroll := false;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetAutoHorizontalScroll(const Value: boolean);
begin
FAutoHorizontalScroll := Value;
if FAutoHorizontalScroll then FAutoDropDownWidth := false;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetBorderColor(const Value: TColor);
begin
if Value <> FBorderColor then begin
FBorderColor := Value;
DrawBorders;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetDisabledColor(const Value: TColor);
var
msg: TMessage;
begin
if Value <> FDisabledColor then begin
FDisabledColor := Value;
CMEnabledChanged(msg);
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetExUI(const Value: boolean);
begin
Perform(CB_SETEXTENDEDUI, integer(Value), 0);
FExtendedInterface := ExtendedInterface;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetFlat(const Value: boolean);
begin
if Value <> FFlat then begin
FFlat := Value;
Ctl3D := not Value;
Invalidate;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetStyle(const Value: TDateTimeStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
if Value = csSimple then
ControlStyle := ControlStyle - [csFixedHeight] else
ControlStyle := ControlStyle + [csFixedHeight];
RecreateWnd;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.TrackButtonPressed(X, Y: integer);
var HelpRect: TRect;
Pressed: boolean;
begin
SetRect(HelpRect, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
Pressed := csButtonPressed in FEditState;
if PtInRect(HelpRect, Point(X, Y)) or (Pressed and FButtonStaysPushed) then
begin
Include(FEditState, csButtonPressed);
// if not Pressed then DrawBorders; //Paint only if state was changed
end
else
begin
Exclude(FEditState, csButtonPressed);
// if Pressed or FButtonStaysPushed then DrawBorders;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.WMLButtonDown(var Message: TWMMouse);
begin
//Uncapture the mouse - ComboBox is focused now
//Mouse was captured when entering ComboBox
//We should set the csButtonPressed here - before Delphi drops down the combo
//This makes the button look like it is being pushed down
MouseCapture := false;
if (Style>csDropDown) then
Include(FEditState, csButtonPressed) //Button should go down even when clicked in edit control
else
TrackButtonPressed(Message.Pos.X, Message.Pos.Y);
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.WMPaint(var Message: TWMPaint);
var DC: HDC;
PS: TPaintStruct;
HelpRect: TRect;
begin
if (not FFlat) then
inherited
else
begin
if Message.DC=0 then DC := BeginPaint(Handle, PS)
else DC := Message.DC;
try
if Style<>csSimple then
begin
//Clip the region - do not let windows paint in border and button areas
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
InflateRect(HelpRect, -2, -2);
Dec(HelpRect.Right, FButtonWidth-1);
IntersectClipRect(DC, HelpRect.Left, HelpRect.Top, HelpRect.Right, HelpRect.Bottom);
end;
//Paint Windows Control
PaintWindow(DC);
finally
if Message.DC=0 then EndPaint(Handle, PS);
end;
//Make Combo look flat
DrawBorders;
end;
end;
//------------------------------------------------------------------------------
end.
Obrigada :)
Michelli
GOSTEI 0
Carlos Júnior
28/11/2011
Michelli,
Eu não instalei o componente, mas eu achei estranho apenas essa linha:
TForm(Self).OnClick := DateTimeByMiClick;
Você não deveria passar o DateTimeByMiClick para o onclick do componente? Aqui vc esta passando para o onClick do Formulario...
At++
Eu não instalei o componente, mas eu achei estranho apenas essa linha:
TForm(Self).OnClick := DateTimeByMiClick;
Você não deveria passar o DateTimeByMiClick para o onclick do componente? Aqui vc esta passando para o onClick do Formulario...
At++
GOSTEI 0
Michelli Moya
28/11/2011
Hummmm na verdade essa linha ai foi uma tentativa de fazer funcionar... e eu deveria ter tirado ela... rsrs..
Isso funcionava sem essa parte, vou postar novamente o codigo do jeito q era pra ser.
Obrigada...
:)
Isso funcionava sem essa parte, vou postar novamente o codigo do jeito q era pra ser.
Obrigada...
//=========================================================================
// EnhComboBox, ImgComboBox Components for Delphi 4
// Author: Norbert ADAMKO
// e-mail: norris@frdsa.utc.sk
// Copyright 1999
//
// Version 1.5, 25 April 1999
//
// For details and credits see ImgCBox.txt
//=========================================================================
unit DateTimebyMi2;
interface
uses
SysUtils, ComCtrls, Windows, Messages, Classes, Forms, Controls, Graphics,
StdCtrls, ImgList, Dialogs;
type
TEnhComboState = set of (csButtonPressed, csMousePressed);
TDateTimeStyle = (csDropDown, csSimple, csDropDownList, csOwnerDrawFixed,csOwnerDrawVariable);
TCustomEnhDateTime = class(TDateTimePicker)
private
FOldColor: TColor;
FOldParentColor: boolean;
FButtonWidth: integer;
FEditState: TEnhComboState;
FMouseInControl: boolean;
FAlwaysShowBorder: boolean;
FAutoDropDownWidth: boolean;
FAutoHorizontalScroll: boolean;
FButtonStaysPushed: boolean;
FExtendedInterface: boolean;
FFlat: boolean;
FBorderColor : TColor;
FDisabledColor : TColor;
FShowBorderWhenInactive: boolean;
FToolTip: boolean;
FOnCloseUp: TNotifyEvent;
FStyle: TDateTimeStyle;
procedure SetStyle(const Value: TDateTimeStyle); virtual;
procedure SetFlat(const Value: boolean);
procedure SetBorderColor(const Value: TColor);
procedure SetDisabledColor(const Value: TColor);
procedure SetExUI(const Value: boolean);
function GetExUI: boolean;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
procedure WMLButtonDown(var Message: TWMMouse); message WM_LBUTTONDOWN;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure TrackButtonPressed(X, Y: integer);
function InsideCombo(X,Y: integer): boolean;
function NeedDraw3DBorder: boolean;
procedure DrawButton(DC: HDC);
procedure DrawButtonBorder(DC: HDC);
procedure DrawControlBorder(DC: HDC);
procedure DrawBorders;
procedure SetAutoDropDownWidth(const Value: boolean);
procedure SetAutoHorizontalScroll(const Value: boolean);
procedure SetAlwaysShowBorder(const Value: boolean);
protected
procedure DoCloseUp; dynamic;
function ItemSize(paDC: hDC; paIndex: Integer; paInEdit: boolean): TSize; virtual;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DestroyWnd; 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 DropDown;
property AlwaysShowBorder: boolean read FAlwaysShowBorder write SetAlwaysShowBorder default false;
property AutoDropDownWidth: boolean read FAutoDropDownWidth write SetAutoDropDownWidth default false;
property AutoHorizontalScroll: boolean read FAutoHorizontalScroll write SetAutoHorizontalScroll default false;
property ButtonStaysPushed: boolean read FButtonStaysPushed write FButtonStaysPushed default false;
property ExtendedInterface: boolean read GetExUI write SetExUI default false;
property Flat: boolean read FFlat write SetFlat default true;
property BorderColor : TColor read FBorderColor write SetBorderColor;
property DisabledColor : TColor read FDisabledColor write SetDisabledColor;
property ShowBorderWhenInactive: boolean read FShowBorderWhenInactive write FShowBorderWhenInactive default false;
property ToolTip: boolean read FToolTip write FToolTip default false;
property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
property Style: TDateTimeStyle read FStyle write SetStyle default csDropDown;
public
constructor Create(AOwner: TComponent); override;
end;
TDateTimeByMi2 = class(TCustomEnhDateTime)
published
property Style; //Must be first
property Flat;
property BorderColor;
property DisabledColor;
property AlwaysShowBorder;
{$IFDEF VER120}
property Anchors;
property AutoDropDownWidth;
property AutoHorizontalScroll;
property BiDiMode;
property ButtonStaysPushed;
property Constraints;
{$ENDIF}
property Color;
property Ctl3D;
property DragCursor;
{$IFDEF VER120}
property DragKind;
{$ENDIF}
property DragMode;
// property DropDownCount;
property Enabled;
property ExtendedInterface;
property Font;
{$IFNDEF VER90}
property ImeMode;
property ImeName;
{$ENDIF}
// property ItemHeight;
// property ItemIndex;
// property Items;
// property MaxLength;
{$IFDEF VER120}
property ParentBiDiMode;
{$ENDIF}
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowBorderWhenInactive;
property ShowHint;
// property Sorted;
property TabOrder;
property TabStop;
property Text;
property Tooltip;
property Visible;
// property OnChange;
property OnCloseUp;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
// property OnDrawItem;
// property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
// property OnMeasureItem;
property OnStartDrag;
{$IFDEF VER120}
property OnEndDock;
property OnStartDock;
{$ENDIF}
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents(byMi, [TDateTimeByMi2]);
end;
{ TCustomEnhDateTime }
//------------------------------------------------------------------------------
constructor TCustomEnhDateTime.Create(AOwner: TComponent);
begin
inherited;
FAlwaysShowBorder := False;
FAutoDropDownWidth := False;
FAutoHorizontalScroll := False;
FButtonWidth := GetSystemMetrics(SM_CXVSCROLL) + 1;
FFlat := True;
FButtonStaysPushed := False;
FShowBorderWhenInactive := False;
FOldColor := Color;
FOldParentColor := ParentColor;
FToolTip := False;
FBorderColor := TColor($00CFCFCF);
FDisabledColor := clWhite;
Style := csDropDownList;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CMEnabledChanged(var Msg: TMessage);
begin
if FFlat then
if Enabled then begin
Color := FOldColor;
ParentColor := false;
end
else begin
FOldParentColor := ParentColor;
FOldColor := Color;
Color := FDisabledColor;
ParentColor := false;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CMEnter(var Message: TCMEnter);
begin
if not (csDesigning in ComponentState) then DrawBorders;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CMExit(var Message: TCMExit);
begin
inherited;
if not (csDesigning in ComponentState) then begin
FMouseInControl := false;
DrawBorders;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CNCommand(var Message: TWMCommand);
begin
case Message.NotifyCode of
CBN_CLOSEUP:
begin
Exclude(FEditState, csButtonPressed);
TrackButtonPressed(-1, -1);
DoCloseUp;
end;
CBN_KILLFOCUS:
begin
end;
CBN_SETFOCUS:
begin
end;
end;
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
Style := Style or WS_HSCROLL;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.CreateWnd;
begin
inherited CreateWnd;
ExtendedInterface := FExtendedInterface;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DestroyWnd;
begin
FExtendedInterface := ExtendedInterface;
inherited DestroyWnd;
end;
//--- Message Handlers-------------------------------------------------------
procedure TCustomEnhDateTime.DoCloseUp;
begin
if Assigned(FOnCloseUp) then FOnCloseUp(Self);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawBorders;
var DC: HDC;
begin
if (FFlat) then begin
DC := GetWindowDC(Handle);
try
DrawControlBorder(DC);
DrawButtonBorder(DC);
finally
ReleaseDC(Handle, DC);
end;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawButton(DC: HDC);
var HelpRect: TRect;
begin
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
Inc(HelpRect.Left, ClientWidth - FButtonWidth);
DrawFrameControl(DC, HelpRect, DFC_SCROLL, DFCS_SCROLLCOMBOBOX or DFCS_FLAT);
ExcludeClipRect(DC, ClientWidth - FButtonWidth - 1, 0, ClientWidth, ClientHeight);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawButtonBorder(DC: HDC);
var HelpRect, HelpRect2: TRect;
BtnFaceBrush: HBRUSH;
begin
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
Inc(HelpRect.Left, ClientWidth - FButtonWidth - 2);
InflateRect(HelpRect, -2, -2);
BtnFaceBrush := CreateSolidBrush(FBorderColor);
try
//Clear the line to the left of the button
InflateRect(HelpRect, -1, -1);
HelpRect2 := HelpRect;
with HelpRect2 do
begin
Right := Left + 2;
Dec(Left, 2);
FillRect(DC, HelpRect2, Brush.Handle);
end;
//Gray out the region
Inc(HelpRect.Left, 1);
FillRect(DC, HelpRect, BtnFaceBrush);
finally
DeleteObject(BtnFaceBrush);
end;
//Clip the borders, so we can paint the button with arrow
IntersectClipRect(DC, HelpRect.Left {+ 2}, HelpRect.Top {+ 1},
HelpRect.Right {- 1}, HelpRect.Bottom {- 1});
DrawButton(DC);
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DrawControlBorder(DC: HDC);
var HelpRect: TRect;
BtnFaceBrush, WindowBrush: HBRUSH;
begin
BtnFaceBrush := CreateSolidBrush(BorderColor);
WindowBrush := CreateSolidBrush(GetSysColor(COLOR_WINDOW));
WindowBrush := CreateSolidBrush(clWhite);
try
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
FrameRect(DC, HelpRect, BtnFaceBrush);
InflateRect(HelpRect, -1, -1);
FrameRect(DC, HelpRect, BtnFaceBrush);
InflateRect(HelpRect, -1, -1);
FrameRect(DC, HelpRect, WindowBrush);
finally
DeleteObject(WindowBrush);
DeleteObject(BtnFaceBrush);
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.DropDown;
var DC: HDC;
OldFont: HFONT;
Size: TSize;
MaxLen, i: integer;
begin
inherited;
if FAutoHorizontalScroll or FAutoDropDownWidth then begin
DC := CreateCompatibleDC(0);
OldFont := SelectObject(DC, Font.Handle);
MaxLen := 0;
// try
// for i:=0 to Items.Count-1 do begin
// Size := ItemSize(DC, i, false);
// if Size.cx>MaxLen then MaxLen := Size.cx;
// end;
// finally
// SelectObject(DC, OldFont);
// DeleteDC(DC);
// end;
//
// if FAutoDropDownWidth then
// if Items.Count>DropDownCount then
// else
end;
end;
//------------------------------------------------------------------------------
function TCustomEnhDateTime.GetExUI: boolean;
begin
Result := boolean(Perform(CB_GETEXTENDEDUI, 0, 0));
end;
//Check if the mouse is in ComboBox area
//------------------------------------------------------------------------------
function TCustomEnhDateTime.InsideCombo(X, Y: integer): boolean;
begin
Result := PtInRect(Rect(0, 0, Width, Height), Point(X, Y));
end;
//---Help Routines----------------------------------------------------------
function TCustomEnhDateTime.ItemSize(paDC: hDC; paIndex: Integer;
paInEdit: boolean): TSize;
var DC: HDC;
OldFont: HFONT;
begin
if paIndex=-1 then begin
Result.cx := 0;
Result.cy := 0;
end
else begin
if paDC=0 then begin
DC := CreateCompatibleDC(0);
OldFont := SelectObject(DC, Font.Handle);
end
else begin
DC := paDC;
OldFont := 0;
end;
try
// GetTextExtentPoint32(DC, PChar(Items[paIndex]), Length(Items[paIndex]), Result);
finally
if paDC=0 then begin
SelectObject(DC, OldFont);
DeleteDC(DC);
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: integer);
begin
SendMessage(Handle,WM_SYSKEYDOWN,VK_DOWN, 0);
// if DroppedDown then begin
MouseCapture := true;
Include(FEditState, csMousePressed);
// end;
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.MouseMove(Shift: TShiftState; X, Y: integer);
begin
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: integer);
begin
MouseCapture := false;
if not FButtonStaysPushed then
begin
Exclude(FEditState, csMousePressed);
TrackButtonPressed(-1, -1);
end;
inherited;
end;
//------------------------------------------------------------------------------
function TCustomEnhDateTime.NeedDraw3DBorder: boolean;
begin
if csDesigning in ComponentState then
Result := Enabled
else
Result := FAlwaysShowBorder or
((FMouseInControl or (Screen.ActiveControl = Self)) and
(ShowBorderWhenInactive or Application.Active));
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetAlwaysShowBorder(const Value: boolean);
begin
if FAlwaysShowBorder <> Value then begin
FAlwaysShowBorder := Value;
Invalidate;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetAutoDropDownWidth(const Value: boolean);
begin
FAutoDropDownWidth := Value;
if FAutoDropDownWidth then FAutoHorizontalScroll := false;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetAutoHorizontalScroll(const Value: boolean);
begin
FAutoHorizontalScroll := Value;
if FAutoHorizontalScroll then FAutoDropDownWidth := false;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetBorderColor(const Value: TColor);
begin
if Value <> FBorderColor then begin
FBorderColor := Value;
DrawBorders;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetDisabledColor(const Value: TColor);
var
msg: TMessage;
begin
if Value <> FDisabledColor then begin
FDisabledColor := Value;
CMEnabledChanged(msg);
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetExUI(const Value: boolean);
begin
Perform(CB_SETEXTENDEDUI, integer(Value), 0);
FExtendedInterface := ExtendedInterface;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetFlat(const Value: boolean);
begin
if Value <> FFlat then begin
FFlat := Value;
Ctl3D := not Value;
Invalidate;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.SetStyle(const Value: TDateTimeStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
if Value = csSimple then
ControlStyle := ControlStyle - [csFixedHeight] else
ControlStyle := ControlStyle + [csFixedHeight];
RecreateWnd;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.TrackButtonPressed(X, Y: integer);
var HelpRect: TRect;
Pressed: boolean;
begin
SetRect(HelpRect, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
Pressed := csButtonPressed in FEditState;
if PtInRect(HelpRect, Point(X, Y)) or (Pressed and FButtonStaysPushed) then
begin
Include(FEditState, csButtonPressed);
// if not Pressed then DrawBorders; //Paint only if state was changed
end
else
begin
Exclude(FEditState, csButtonPressed);
// if Pressed or FButtonStaysPushed then DrawBorders;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.WMLButtonDown(var Message: TWMMouse);
begin
//Uncapture the mouse - ComboBox is focused now
//Mouse was captured when entering ComboBox
//We should set the csButtonPressed here - before Delphi drops down the combo
//This makes the button look like it is being pushed down
MouseCapture := false;
if (Style>csDropDown) then
Include(FEditState, csButtonPressed) //Button should go down even when clicked in edit control
else
TrackButtonPressed(Message.Pos.X, Message.Pos.Y);
inherited;
end;
//------------------------------------------------------------------------------
procedure TCustomEnhDateTime.WMPaint(var Message: TWMPaint);
var DC: HDC;
PS: TPaintStruct;
HelpRect: TRect;
begin
if (not FFlat) then
inherited
else
begin
if Message.DC=0 then DC := BeginPaint(Handle, PS)
else DC := Message.DC;
try
if Style<>csSimple then
begin
//Clip the region - do not let windows paint in border and button areas
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
InflateRect(HelpRect, -2, -2);
Dec(HelpRect.Right, FButtonWidth-1);
IntersectClipRect(DC, HelpRect.Left, HelpRect.Top, HelpRect.Right, HelpRect.Bottom);
end;
//Paint Windows Control
PaintWindow(DC);
finally
if Message.DC=0 then EndPaint(Handle, PS);
end;
//Make Combo look flat
DrawBorders;
end;
end;
//------------------------------------------------------------------------------
end.
:)
GOSTEI 0
Wilson Junior
28/11/2011
Não esqueça de finalizar o tópico.
GOSTEI 0