[duhar]

Как раз таки самая суть была в прибамбасах. Страница не хотела удаляться пока не были удалены контролы расположенные на ней. После их последовательного удаления все пошло как по маслу. Огроменное тебе спасибо, друк. Очень очень выручил :a3:

[duhar]

Благодарствую

:a3:

[duhar]

'Feg16' wrote:

Больше экспериментировать не стал, так как в том или ином случае зачастую появлялся AV с корнями хз откуда

Спасибо большое, правда местами не совсем понятно что именно все таки делается. Не могли бы вы, если вам не составит большого труда, закомментировать код?

Проблема в том, что при использовании данного кода у меня появляются исключения.

[duhar]

'Support' wrote:

В новом приложении реально это воспроизвести?

Это касается только версии 7.61?

Воспроизвести не получается =(.

У меня установлена версия 7.61.

Буду искать причину.

[duhar]

Решение конечно не плохое, но смотрится совсем не гармонично. Я использую наследника от TsComboBox

Code:

type
TListBoxTip = class(THintWindow)
end;

TShowComboToolTipEvent = procedure(Sender: TObject;
const ToolTipText: string;
var HideToolTip: Boolean) of object;

THSHintComboBox = class(TsComboBox)
private
FListBoxTip: TListBoxTip;
FListHandle: HWND;
FListWndProcInstance: TFarProc;
FOldListWndProc: TFarProc;
FOnListMouseMove: TMouseMoveEvent;
FOnShowComboToolTip: TShowComboToolTipEvent;
FShowToolTips: Boolean;
FHorizontalExtent: Integer;
procedure ListWndProc(var Message: TMessage);
function ListBoxItemAtPos(I: Integer): string;
function ListBoxItemRectAtPos(I: Integer; AText: string): TRect;
procedure SetShowToolTips(const Value: Boolean);
procedure SetHorizontalExtent(const Value: Integer);
protected
procedure DoListMouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
procedure DoShowComboToolTip(const ToolTipText: string;
var HideToolTip: Boolean); dynamic;
procedure WndProc(var Message: TMessage); override;
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CreateWnd; override;
property HSListHandle: HWND read FListHandle;
property ShowToolTips: Boolean read FShowToolTips
write SetShowToolTips default true;
property OnListMouseMove: TMouseMoveEvent read FOnListMouseMove
write FOnListMouseMove;
property OnShowComboToolTip: TShowComboToolTipEvent
read FOnShowComboToolTip write FOnShowComboToolTip;
property HorizontalExtent: Integer read FHorizontalExtent
write SetHorizontalExtent default -1;
end;

Code:

function RectWidth(R: TRect): Integer;
begin
Result := R.Right – R.Left;
end;

function RectHeight(R: TRect): Integer;
begin
Result := R.Bottom – R.Top;
end;

{ THSHintComboBox }

constructor THSHintComboBox.Create(AOwner: TComponent);
begin
inherited;
FListBoxTip := TListBoxTip.Create(Self);
FListBoxTip.Color := clInfoBk;
FListWndProcInstance := MakeObjectInstance(ListWndProc);
FShowToolTips := true;
FHorizontalExtent := -1;
end;

destructor THSHintComboBox.Destroy;
begin
if (FListHandle <> 0) and IsWindow(FListHandle) then
SetWindowLong(FListHandle, GWL_WNDPROC, LongInt(FOldListWndProc));
FreeObjectInstance(FListWndProcInstance);
inherited;
end;

procedure THSHintComboBox.DoShowComboToolTip(const ToolTipText: string;
var HideToolTip: Boolean);
begin
if Assigned(FOnShowComboToolTip) then
FOnShowComboToolTip(Self, ToolTipText, HideToolTip);
end;

procedure THSHintComboBox.DoListMouseMove(Shift: TShiftState; X,
Y: Integer);

procedure AdjustHintRect(var R: TRect; const AHintStr: string);
var
DC: HDC;
OldFont: HFONT;
TextSize: SIZE;
begin
DC := GetDC(HWND_DESKTOP);
try
OldFont := SelectObject(DC, Screen.HintFont.Handle);
try
if (not GetTextExtentPoint32(DC, PChar(AHintStr), StrLen(PChar(AHintStr)), TextSize)) then
RaiseLastWin32Error;
Inc(TextSize.cx, 6);
Inc(TextSize.cy, 2);
if RectWidth(R) < TextSize.cx then
R.Right := R.Left + TextSize.cx;
if RectHeight(R) < TextSize.cy then
R.Bottom := R.Top + TextSize.cy;
finally
SelectObject(DC, OldFont);
end;
finally
ReleaseDC(HWND_DESKTOP, DC);
end;
end;

var R, ItemRect: TRect;
I: Integer;
ItemText: string;
HideToolTip: Boolean;
begin
HideToolTip := True; begin
Windows.GetClientRect(FListHandle, R);
if PtInRect(R, Point(X, Y)) and (Shift = []) then begin
I := SendMessage(FListHandle, LB_ITEMFROMPOINT, 0, MakeLParam(X, Y));
if HiWord(I) <> 0 then
I := -1;
if I <> -1 then begin
ItemText := ListBoxItemAtPos(I);
ItemRect := ListBoxItemRectAtPos(I, ItemText);
if RectWidth(ItemRect) > RectWidth(R) then begin
Windows.ClientToScreen(FListHandle, ItemRect.TopLeft);
Windows.ClientToScreen(FListHandle, ItemRect.BottomRight);
Dec(ItemRect.Left, 3);
Inc(ItemRect.Right, 6);
HideToolTip := false;
DoShowComboToolTip(ItemText, HideToolTip);
if not HideToolTip then

if not (IsWindow(FListBoxTip.Handle) and
IsWindowVisible(FListBoxTip.Handle) and
(StrComp(PChar(FListBoxTip.Caption), PChar(ItemText)) = 0)) then begin
AdjustHintRect(ItemRect, ItemText);
FListBoxTip.ActivateHint(ItemRect, ItemText);
end;
end;
end;
end;
end;
if HideToolTip then
FListBoxTip.ReleaseHandle;
if Assigned(FOnListMouseMove) then
FOnListMouseMove(Self, Shift, X, Y);
end;

function THSHintComboBox.ListBoxItemAtPos(I: Integer): string;
var
L: Integer;
begin
if I <> -1 then begin
L := SendMessage(FListHandle, LB_GETTEXTLEN, I, 0);
SetLength(Result, L + 1);
SendMessage(FListHandle, LB_GETTEXT, I, Integer(PChar(Result)));
end else
Result := '';
end;

function THSHintComboBox.ListBoxItemRectAtPos(I: Integer;
AText: string): TRect;
var
DC: HDC;
OldFont: HFONT;
begin
Result := Rect(0, 0, 0, 0);
if (I <> -1) and (SendMessage(FListHandle, LB_GETITEMRECT, I,
Integer(@Result)) <> LB_ERR) then begin
DC := GetDC(FListHandle);
try
OldFont := SelectObject(DC, Font.Handle);
try
DrawText(DC, PChar(AText), -1, Result, DT_CALCRECT);
finally
SelectObject(DC, OldFont);
end;
finally
ReleaseDC(FListHandle, DC);
end;
end;
end;

procedure THSHintComboBox.ListWndProc(var Message: TMessage);
begin
case Message.Msg of
WM_MOUSEMOVE:
with TWMMouseMove(Message) do
DoListMouseMove(KeysToShiftState(Keys), XPos, YPos);
WM_SHOWWINDOW:
if Message.WParam = 0 then
FListBoxTip.ReleaseHandle();
end;
with Message do
Result := CallWindowProc(FOldListWndProc, FListHandle, Msg, WParam, LParam);
end;

procedure THSHintComboBox.SetShowToolTips(const Value: Boolean);
begin
FShowToolTips := Value;
end;

procedure THSHintComboBox.WndProc(var Message: TMessage);
begin
if (Message.Msg = WM_CTLCOLORLISTBOX) and (FListHandle = 0) then begin
FListHandle := HWND(Message.LParam);
FOldListWndProc := Pointer(GetWindowLong(FListHandle, GWL_WNDPROC));
SetWindowLong(FListHandle,
GWL_WNDPROC, LongInt(FListWndProcInstance));
end;
inherited;
end;

procedure THSHintComboBox.CreateParams(var Params: TCreateParams);
begin
inherited;
if FHorizontalExtent <> -1 then
with Params do
Style := Style or WS_HSCROLL;
end;

procedure THSHintComboBox.SetHorizontalExtent(const Value: Integer);
begin
if (FHorizontalExtent <> Value) then begin
FHorizontalExtent := Value;
if not (csLoading in ComponentState) then
RecreateWnd();
end;
end;

procedure THSHintComboBox.CreateWnd;
begin
inherited;
if FHorizontalExtent <> -1 then
Perform(CB_SETHORIZONTALEXTENT, FHorizontalExtent, 0);
end;

З.Ы. Код не мой, найден на просторах интернета. Работает без нареканий

[duhar]

'Witcher' wrote:

Все почти точно так же, только на Дельфи:

Code:

procedure TForm1.ApplicationEvents1ShowHint(var HintStr: string;
var CanShow: Boolean; var HintInfo: THintInfo);
begin
if (HintInfo.HintControl.ClassNameIs('TComboBox')) then//у ComboBox ShowHint=true
begin
if(Canvas.TextWidth((HintInfo.HintControl as TComboBox).Text) > (HintInfo.HintControl as TComboBox).ClientWidth) then
begin
HintStr := (HintInfo.HintControl as TComboBox).Text;
ApplicationEvents1.CancelDispatch;
end;
end;
end;

Так показывается подсказка только к выбранной строке ComboBox. А я имел ввиду подсказки для длинных строк в раскрывающемся списке. Чтобы при небольшой ширине комбобокса видеть наглядно что именно выбираешь.

[duhar]

я вообще про делфи =). Но знаю как в нем реализовать сие действие программно. Но, на мой взгляд, было бы удобно добавить это прямо в компонент, дабы расширить его возможности.

[duhar]

'Witcher' wrote:

Предложение хорошее, принято на заметку. По срокам ничего точно сказать не могу.

Спасибо! =)

[duhar]

'Astii' wrote:

Использовать сторонний компонент, который скинируется.

Ярлычки из “DevExpress” точно разной ширины и они скинируются, но они платные и тяжёлые. Наверняка есть другие, которые подойдут.

А например? Уж очень нехочется отказываться от sPageControl. удобный он =)

[duhar]

'Astii' wrote:

Напиши, как удаляешь, чтоб ошибок не было.

У меня что-то подобное было. Причём TPageControl позволял безошибочно удалять по разному.

Спасибо, я уже решил данную проблему.

[duhar]

Извиняюсь, проблема не в PageControle, а в том что он некорректно удаляется.

Вопрос снят.

Спасибо за внимание.

[duhar]

Неужели это невозможно? 🙁 🙁 🙁

[duhar]

Quote:

Попробуй tag = -98

Спасибо огромное

[duhar]

Такая же проблема, если создавать свой скин, через SkinEditor на всех диалоговых окнах есть эти белые полосы.

[Author]

Posts