Форум: "Прочее";
Текущий архив: 2007.11.04;
Скачать: [xml.tar.bz2];
ВнизПрозрачный scrollbox Найти похожие ветки
← →
opa4ki2 (2007-09-30 14:12) [0]Доброго времени суток.
Может кто подскажет компонент (желательно бесплатный). Прозрачный ScrollBox
← →
opa4ki2 (2007-09-30 14:20) [1]нашел AdvScrollBox, но блин, мегает фон...
← →
Вася Правильный (2007-09-30 18:21) [2]прозрачный=невидимый?
← →
homm © (2007-09-30 18:38) [3]> [2] Вася Правильный (30.09.07 18:21)
> прозрачный=невидимый?
нет
← →
Вася Правильный (2007-09-30 18:58) [4]
> > прозрачный=невидимый?
> нет
но если видимый, то непрозрачный же
← →
homm © (2007-09-30 19:07) [5]> [4] Вася Правильный (30.09.07 18:58)
> но если видимый, то непрозрачный же
с прозрачной коиентской областью, но не компонентами на нем.
← →
Черный Шаман (2007-09-30 19:19) [6]
> opa4ki2 (30.09.07 14:20) [1]
>
> нашел AdvScrollBox, но блин, мегает фон...
Без тормозов и извращений нормального прозрачного наследника от WinControl не сделать.
Вот тебе пример, можешь проверить.
unit TransparentGroupBox;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TTransparentGroupBox = class(TGroupBox)
private
{ Private declarations }
FBevelLowColor: TColor;
FBevelHiColor: TColor;
procedure SetBvlLowColor(Value: TColor);
procedure SetBvlHiColor(Value: TColor);
Procedure WMEraseBkGnd(Var Message:TWMEraseBkGnd); Message WM_EraseBkGnd;
Procedure WMMove(Var Message:TWMMove); Message WM_Move;
protected
{ Protected declarations }
Procedure CreateParams(Var Params:TCreateParams); Override;
Procedure Paint; Override;
Procedure SetParent(AParent:TWinControl); Override;
procedure DrawFrame(Rect:TRect);
public
{ Public declarations }
Constructor Create(AOwner:TComponent); Override;
Procedure Invalidate; Override;
published
{ Published declarations }
property BevelShadowColor:TColor read FBevelLowColor
write SetBvlLowColor;
property BevelHighlightColor:TColor read FBevelHiColor
write SetBvlHiColor;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents("Standard", [TTransparentGroupBox]);
end;
constructor TTransparentGroupBox.Create (AOwner: TComponent);
Begin
Inherited Create(AOwner);
ControlStyle:= ControlStyle - [csOpaque];
FBevelLowColor := clBtnShadow;
FBevelHiColor := clBtnHighlight;
End;
Procedure TTransparentGroupBox.CreateParams(Var Params:TCreateParams);
Begin
inherited CreateParams (Params);
Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
End;
Procedure TTransparentGroupBox.Paint;
var
H: Integer;
R: TRect;
begin
with Canvas do
begin
Font := Self.Font;
H := TextHeight("0");
R := Rect(0, H div 2 - 1, Width, Height);
if Ctl3D then
begin
DrawFrame(R);
end else
begin
Brush.Color := clWindowFrame;
FrameRect(R);
end;
if Text <> "" then
begin
R := Rect(8, 0, 0, H);
DrawText(Handle, PChar(Text), Length(Text), R, DT_LEFT or
DT_SINGLELINE or
DT_CALCRECT);
if Ctl3D then
Brush.Style:= bsClear
else
Brush.Color := Color;
DrawText(Handle, PChar(Text), Length(Text), R, DT_LEFT or
DT_SINGLELINE);
end;
end;
End;
Procedure TTransparentGroupBox.WMEraseBkGnd(Var Message:TWMEraseBkGnd);
Begin
Repaint;
End;
Procedure TTransparentGroupBox.SetParent(AParent:TWinControl);
Begin
Inherited SetParent(AParent);
If Parent <> Nil then
SetWindowLong(Parent.Handle, GWL_STYLE,
GetWindowLong(Parent.Handle, GWL_STYLE)
And Not WS_ClipChildren);
End;
Procedure TTransparentGroupBox.Invalidate;
Var
Rect :TRect;
Begin
Rect:= BoundsRect;
If (Parent <> Nil) and Parent.HandleAllocated then
InvalidateRect(Parent.Handle, @Rect, True)
Else
Inherited Invalidate;
End;
Procedure TTransparentGroupBox.WMMove(Var Message:TWMMove);
Begin
Invalidate;
End;
procedure TTransparentGroupBox.SetBvlLowColor(Value: TColor);
begin
if FBevelLowColor <> Value then
FBevelLowColor := Value;
Invalidate;
end;
procedure TTransparentGroupBox.SetBvlHiColor(Value: TColor);
begin
if FBevelHiColor <> Value then
FBevelHiColor := Value;
Invalidate;
end;
procedure TTransparentGroupBox.DrawFrame(Rect: TRect);
var
CaptionLength: Integer;
begin
with Canvas do
begin
Inc(Rect.Left);
Inc(Rect.Top);
Dec(Rect.Right);
Dec(Rect.Bottom);
CaptionLength := TextWidth(Text);
Pen.Color := FBevelHiColor;
MoveTo(Rect.Left, Rect.Top);
LineTo(6,Rect.Top);
MoveTo(8+CaptionLength+2, Rect.Top);
LineTo(Rect.Right,Rect.Top);
LineTo(Rect.Right,Rect.Bottom);
LineTo(Rect.Left,Rect.Bottom);
LineTo(Rect.Left, Rect.Top);
OffsetRect(Rect, -1, -1);
Pen.Color := FBevelLowColor;
MoveTo(Rect.Left, Rect.Top);
LineTo(6,Rect.Top);
MoveTo(8+CaptionLength+2, Rect.Top);
LineTo(Rect.Right,Rect.Top);
LineTo(Rect.Right,Rect.Bottom);
LineTo(Rect.Left,Rect.Bottom);
LineTo(Rect.Left, Rect.Top);
end;
end;
end.
← →
Черный Шаман (2007-09-30 19:22) [7]
>
> opa4ki2 (30.09.07 14:12)
>
> Доброго времени суток.
> Может кто подскажет компонент (желательно бесплатный). Прозрачный
> ScrollBox
Я делал прозрачные контролы с возможностью эмуляции получения фокуса через связку GraphicControl(с поддержкой Unicode) и наследника от WinControl, получавший сообщения и маршрутизирувавшего их GraphicControl
← →
homm © (2007-09-30 19:28) [8]> [6] Черный Шаман (30.09.07 19:19)
> And Not WS_ClipChildren
Этот стиль — зло, а имеено на нем здесь все и держится.
← →
Черный Шаман (2007-09-30 19:50) [9]
> homm © (30.09.07 19:28) [8]
>
> > [6] Черный Шаман (30.09.07 19:19)
> > And Not WS_ClipChildren
>
> Этот стиль — зло, а имеено на нем здесь все и держится.
Поэтому я его не использую.
← →
имя (2007-10-07 22:23) [10]Удалено модератором
Страницы: 1 вся ветка
Форум: "Прочее";
Текущий архив: 2007.11.04;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.041 c