PDA

View Full Version : GroupBox با امکانات BorderColor و BorderWidth



Developer Programmer
شنبه 12 شهریور 1384, 21:13 عصر
چرا تغییرات در Canvas اعمال نمی شن؟
(کامپوننت ضمیمه شده)

SalarSoft
چهارشنبه 16 شهریور 1384, 10:57 صبح
برای اینکه بتونی رنگ کادر اطراف رو عوض کنی باید متد Paint رو باز نویسی کنی.

از inherited هم در متد هایی که override شده اند استفاده کن.

و برای اینکه بتونی عرض کادر رو تغییر بدی باید یک تغییر اساسی تو متد paint بدی که این کار رو به خودت واگذار میکنم.



unit G;
interface
uses
{recommended}Windows, {recommended}Themes, SysUtils, Classes, Controls, StdCtrls, Graphics;
type
TG = class(TGroupBox)
Private
fBorderWidth: Integer;
fBorderShadowColor: TColor;
fBorderHighlightColor: TColor;

protected
procedure SetBorderHighlightColor(const Value: TColor);
procedure SetBorderShadowColor(const Value: TColor);
procedure Paint; override;
public
constructor Create(AOwner: TComponent); Override;
published
property BorderHighlightColor:TColor read fBorderHighlightColor write SetBorderHighlightColor;
property BorderShadowColor:TColor read fBorderShadowColor write SetBorderShadowColor;
//property BorderWidth:Integer read fBorderWidth write SetWidth;//
end;

procedure Register;
implementation
//************************************************** **
constructor TG.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fBorderShadowColor:=clBtnShadow;
fBorderHighlightColor:=clBtnHighlight;
//fBorderWidth:=1;
end;
//************************************************** **
procedure TG.Paint;
var
H: Integer;
R: TRect;
Flags: Longint;
CaptionRect,
OuterRect: TRect;
Size: TSize;
Box: TThemedButton;
Details: TThemedElementDetails;
begin
with Canvas do
begin
Font := Self.Font;

if ThemeServices.ThemesEnabled then
begin
if Text <> '' then
begin
GetTextExtentPoint32(Handle, PChar(Text), Length(Text), Size);
CaptionRect := Rect(0, 0, Size.cx, Size.cy);
if not UseRightToLeftAlignment then
OffsetRect(CaptionRect, 8, 0)
else
OffsetRect(CaptionRect, Width - 8 - CaptionRect.Right, 0);
end
else
CaptionRect := Rect(0, 0, 0, 0);
OuterRect := ClientRect;
OuterRect.Top := (CaptionRect.Bottom - CaptionRect.Top) div 2;
with CaptionRect do
ExcludeClipRect(Handle, Left, Top, Right, Bottom);
if Enabled then
Box := tbGroupBoxNormal
else
Box := tbGroupBoxDisabled;
Details := ThemeServices.GetElementDetails(Box);
ThemeServices.DrawElement(Handle, Details, OuterRect);

SelectClipRgn(Handle, 0);
if Text <> '' then
ThemeServices.DrawText(Handle, Details, Text, CaptionRect, DT_LEFT, 0);
end
else
begin
H := TextHeight('0');
R := Rect(0, H div 2 - 1, Width, Height);
if Ctl3D then
begin
Inc(R.Left);
Inc(R.Top);
//Brush.Color := clBtnHighlight;//go away!
//my love!
Brush.Color :=fBorderHighlightColor;
FrameRect(R);
OffsetRect(R, -1, -1);
//Brush.Color := clBtnShadow;//go away!
//my love!
Brush.Color :=fBorderShadowColor;
end else
Brush.Color := clWindowFrame;
FrameRect(R);
if Text <> '' then
begin
if not UseRightToLeftAlignment then
R := Rect(8, 0, 0, H)
else
R := Rect(R.Right - Canvas.TextWidth(Text) - 8, 0, 0, H);
Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
DrawText(Handle, PChar(Text), Length(Text), R, Flags or DT_CALCRECT);
Brush.Color := Color;
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
end;
end;
end;
end;

procedure TG.SetBorderHighlightColor(const Value: TColor);
begin
if fBorderHighlightColor <> Value then begin
fBorderHighlightColor := Value;
Invalidate;
end;
fBorderHighlightColor := Value;
end;

procedure TG.SetBorderShadowColor(const Value: TColor);
begin
//Afshin_Zavar! use inherited keyword in overrided methods!
//inherited;
if fBorderShadowColor <> Value then begin
fBorderShadowColor := Value;
Invalidate;//
end;
end;

//************************************************** **
procedure Register;
begin
RegisterComponents('DevilKiller', [TG]);
end;
end.

tanha2005
جمعه 18 شهریور 1384, 15:24 عصر
با سلام
خیلی فوری
دنبال یک کامپوننت هستم که بتوانه اندازه منوهای دلفی را بزرگ کنه ؟


**********************************************
زندگی گرمایی نیست که در جستجوی گشودن آن باشیم
زندگی واقیعیتی است که باید آن را تجربه کنیم

Developer Programmer
جمعه 18 شهریور 1384, 21:39 عصر
دنبال یک کامپوننت هستم که بتوانه اندازه منوهای دلفی را بزرگ کنه ؟

هر سوال را در جای مربوط به خودش می پرسن ! دقت کن ! ... اینجا کسی واست دنبال کامپوننت نمیگرده خواستی از گوگل سرچ کن
...
سالار جان؛ کامپوننت ، فقط تا زمانی که از XPManifest استفاده نشده، درست جواب میده ...

SalarSoft
یک شنبه 20 شهریور 1384, 12:43 عصر
کامپوننت ، فقط تا زمانی که از XPManifest استفاده نشده، درست جواب میده ...
طبیعیه! کد ThemeServices.ThemesEnabled نشان دهنده اینه که در برنامه theme های ویندوز xp اعمال میشود یا نه.
برای اینکه این قابلیت رو در TG غیر فعال کنید باید متد paint رو اینطوری اصلاح کنی:



procedure TG.Paint;
var
H: Integer;
R: TRect;
Flags: Longint;
CaptionRect,
OuterRect: TRect;
Size: TSize;
Box: TThemedButton;
Details: TThemedElementDetails;
begin
with Canvas do
begin
Font := Self.Font;

H := TextHeight('0');
R := Rect(0, H div 2 - 1, Width, Height);
if Ctl3D then
begin
Inc(R.Left);
Inc(R.Top);
//Brush.Color := clBtnHighlight;//go away!
//my love!
Brush.Color :=fBorderHighlightColor;
FrameRect(R);
OffsetRect(R, -1, -1);
//Brush.Color := clBtnShadow;//go away!
//my love!
Brush.Color :=fBorderShadowColor;
end else
Brush.Color := clWindowFrame;
FrameRect(R);
if Text <> '' then
begin
if not UseRightToLeftAlignment then
R := Rect(8, 0, 0, H)
else
R := Rect(R.Right - Canvas.TextWidth(Text) - 8, 0, 0, H);
Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
DrawText(Handle, PChar(Text), Length(Text), R, Flags or DT_CALCRECT);
Brush.Color := Color;
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
end;

end;
end;

استفاده از یونیت themes برای استفاده از امکانات theme ویندوز xp است و به همین درد میخوره.


هر سوال را در جای مربوط به خودش می پرسن ! دقت کن ! ... اینجا کسی واست دنبال کامپوننت نمیگرده خواستی از گوگل سرچ کن
چرا اینقدر خشن برخورد می کنی، یه نگاهی به تعداد پستش بکن هنوز تازه کاره. :چشمک: