Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Прочее";
Текущий архив: 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
3-1182775113
dest81
2007-06-25 16:38
2007.11.04
права доступа в ib


2-1192110897
ИГОРЬ
2007-10-11 17:54
2007.11.04
Замена Yes No Cancel на Да Нет Отмена


15-1191222209
AntiUser
2007-10-01 11:03
2007.11.04
Microsoft продлевает срок продажи Windows XP до 30 июня 2008 года


2-1192321828
dreamse
2007-10-14 04:30
2007.11.04
Подскажите как получить название каталога из пути ?


15-1191594464
joke
2007-10-05 18:27
2007.11.04
Как человеку вежливо...





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский