Текущий архив: 2007.11.04;
Скачать: CL | DM;

Вниз

Прозрачный 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;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.018 c