SUIPack发布3.0版—您想使您应用程序具有 MacOS 或 WinXP 风格或其它更酷的外观吗？

[Nicrosoft]

您想使您应用程序具有 MacOS 或 WinXP 风格或其它更酷的外观吗？
您想基于一幅位图创建任意形状的不规则窗口吗？
现在您可以完全都做到，并且不用编写一行代码！

SUIPack 是一款面向Delphi程序员的界面增强VCL组件。它可以帮助你制作出占用资源小的个性化界面应用程序！
SUIPack 兼容Delphi 5、Delphi 6、Delphi 7、C++Builder 5、C++Builder 6！

SUIPack 提供了23 个组件用于增强在Delphi中的界面编程
SUIPack 提供了 5 种现成的界面风格的布景：MacOS、WinXP、DeepBlue、BlueGlass、Protein.
屏幕截图：
http://www.sunisoft.com/suipack/theme_mac.htm
http://www.sunisoft.com/suipack/theme_xp.htm
http://www.sunisoft.com/suipack/theme_db.htm
http://www.sunisoft.com/suipack/theme_bg.htm
http://www.sunisoft.com/suipack/theme_pt.htm

组件：
TsuiSkinForm - 无需编写一行代码，即可根据位图创建不规则窗口的Form组件。
TsuiSkinControl - 无需编写一行代码，即可根据位图创建不规则的控件。
TsuiForm - 改变整个Form外观的组件。
TsuiMainMenu - 为配合TsuiForm而设计，支持 SUIPack 风格外观且可定制。
TsuiPopupMenu - 支持 SUIPack 风格外观且可定制的 popup menu。
TsuiSideChannel - 置于边上的，可弹出式的面板。
TsuiTitleBar - SUIPack 外观风格的TitleBar。
TsuiImagePanel - 能够显示图片作为背景的Panel。
TsuiButton - SUIPack风格的按钮。
TsuiCheckBox - SUIPack风格的CheckBox。
TsuiRadioButton - SUIPack风格的RadionButton。
TsuiProgressBar - SUIPack外观风格的ProgressBar
TsuiURLLabel - 能显示URL的Label。
TsuiEdit - 平面效果的Edit。
TsuiMemo - 平面效果的Memo。
TsuiListBox - 平面效果的ListBox。
TsuiComboBox - SUIPack 风格的ComboBox。
TsuiCheckListBox - 平面效果的 CheckListBox。
TsuiGroupBox - 平面效果的GroupBox。
TsuiRadioGroup - 提供一组具有 SUIPack 风格的 Radio button 的控件。
TsuiCheckGroup - 提供一组具有 SUIPack 风格的 Check Box 的控件。
TsuiListView - 平面效果的 ListView 控件。
TsuiTreeView - 平面效果的 TreeView 控件。

更多信息：
http://www.sunisoft.com/gb/suipack/

[xuefl66]

: see

[BoningSword]

好像delphi7的就带有XP风格的控件了啊？、

[D_Q]

不错 Down 看看 呵呵~~

[cgh1970]

up

[cdimp]

不错 !!!!

[extreme0001]

我没钱，但我要！

[zdcnow]

做得很不错，佩服！

[extreme0001]

可以免费送一个吗？

[tujunhui]

能不能发个过来？

[esan]

各位老兄,30元人民币也就是一餐KFC而已,这么好用的组件想用不会就少这30元吧,要自己开发成本可是和这价格没得比的.

[konichiha]

可惜要注册

[luoming]

UP

[smhpnuaa]

免费使用雅龙工作室的窗口代码：

unit HCForms;

interface

uses
Windows, SysUtils, WinTypes, WinProcs, Messages, Classes, Controls,
Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Graphics, UrlLabel;

const
CaptionMinHeightPattern= 0;
CaptionHeightThreshold= 20;

clHCDarkGreen= {clBlack} $00308912;
clHCMidGreen= {clTeal } $0089CEB2;
clHCLightGreen= {clYellow } $00CCF7E6;

type
THCForm = class(TYalongForm)

private
fCaptionHeight: integer; {height of the title bar in pixels}
fActiveCaption: boolean; {state of the title bar}
fSysMenu, fMin, fMax, fClose: boolean;
fMenuUp: boolean; {state of the system menu}
function TestWinStyle(dwStyleBit : longInt): boolean;
function HasCaption: boolean;
function GetCaptionRect(var Rect: TRect): boolean;
function GetCaptionButtonRect(Which: word; var Rect: TRect): boolean;
procedure DrawCaptionButton(DC: HDC; Which: word; Pressed: boolean);
function DrawCaption: boolean;
function DepressCaptionButton(Which: word) : boolean;
function DoSysMenu : boolean;
procedure DrawWallpapper(DC: hDC);
protected
procedure WndProc(var Message: TMessage); override;
procedure WMNCCreate(var Message: TWMNCCreate); message WM_NCCREATE;
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
procedure WMNCLButtonDblClk(var Message: TWMNCLButtonDblClk); message WM_NCLBUTTONDBLCLK;
procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;

procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMSysChar(var Message: TWMSysChar); message WM_SYSCHAR;
procedure WMCommand(var Message: TMessage); message WM_COMMAND;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMSysKeyDown(var Message: TWMSysKeyDown); message WM_SYSKEYDOWN;
procedure WMSysKeyUp(var Message: TWMSysKeyUp); message WM_SYSKEYUP;
procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;
public
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
end;
var
HCForm:THCForm;
implementation

{$R *.DFM}
{$R UIRes.res}

type
PSysMenuItem= ^TSysMenuItem;
TSysMenuItem= Packed Record
SysMenuItemID: DWORD;
SysMenuItemText: PChar;
End;

//得到窗口的Style
function THCForm.TestWinStyle(dwStyleBit: longInt): boolean;
begin
Result:= ((GetWindowLong(Handle, GWL_STYLE) AND dwStyleBit) <> 0);
end;

//判断窗口是否包含标题
function THCForm.HasCaption: boolean;
begin
Result:= TestWinStyle(WS_CAPTION) {BorderStyle <> bsNone};
end;

//得到窗口标题区域
function THCForm.GetCaptionRect(var Rect: TRect): boolean;
begin
If HasCaption Then Begin
GetWindowRect(Handle, Rect);
{Adjust for borders}
If TestWinStyle(WS_THICKFRAME) Then Begin
InflateRect(Rect, -GetSystemMetrics(SM_CXFRAME),-GetSystemMetrics(SM_CYFRAME));
End Else Begin
If TestWinStyle(DS_MODALFRAME) Then Begin
InflateRect(Rect,
-(GetSystemMetrics(SM_CXDLGFRAME)+ GetSystemMetrics(SM_CXBORDER)),
-(GetSystemMetrics(SM_CYDLGFRAME)+ GetSystemMetrics(SM_CYBORDER))
);
End Else Begin
If TestWinStyle(WS_BORDER) Then Begin
InflateRect(Rect, -GetSystemMetrics(SM_CXBORDER),-GetSystemMetrics(SM_CYBORDER));
End;
End;
End;
Rect.Bottom:= Rect.Top + fCaptionHeight;
Result:= True;
End Else Begin
SetRectEmpty(Rect);
Result:= False;
End;
end;

//得到窗口按钮区域
function THCForm.GetCaptionButtonRect(Which:word; var Rect: TRect): boolean;
Procedure SetButtonRect;
Var
pButton: byte;
Begin
pButton:=0;
Case Which Of
HTMINBUTTON: Begin
If TestWinStyle(WS_MAXIMIZEBOX) Then Begin
Inc(pButton);
End;
If TestWinStyle(WS_SYSMENU) Then Begin
Inc(pButton);
End;
End;
HTMAXBUTTON: Begin
If TestWinStyle(WS_SYSMENU) Then Begin
Inc(pButton);
End;
End;
End;
{ Draw them into the right side on caption /width=height/ }
Dec(Rect.Right, fCaptionHeight * pButton + 1);
Rect.Left:= Rect.Right-fCaptionHeight + 2;
End;

begin
Result:= False;
If GetCaptionRect(Rect) Then Begin
Inc(Rect.Top);
Dec(Rect.Bottom);
Case Which Of
HTSYSMENU: Begin
If TestWinStyle(WS_SYSMENU) Then Begin
{ Draw it into the left side on caption /width=height/ }
Rect.Right:=Rect.Left + fCaptionHeight - 1;
Result:= True;
End;
End;
HTMINBUTTON: Begin
If TestWinStyle(WS_MINIMIZEBOX) Then Begin
SetButtonRect;
Result:= True;
End;
End;
HTMAXBUTTON: Begin
If TestWinStyle(WS_MAXIMIZEBOX) Then Begin
SetButtonRect;
Result:= True;
End;
End;
HTCLOSE: Begin
If TestWinStyle(WS_SYSMENU) Then Begin
SetButtonRect;
Result:= True;
End;
End;
End;
End;
If NOT Result Then SetRectEmpty(Rect);
end;

[smhpnuaa]

//------------------------------------------------------------------------------
// 绘制客户区
procedure THCForm.DrawWallpapper( DC: hDC );
var
cx,cy:integer;
imgClient:Tbitmap;
begin
cx:=0;
cy:=0;
imgClient:=TBitmap.Create;
try
imgClient.LoadFromResourceName(0,'STYLE5_FORM_BACKGROUND');
While cy<height do begin
While cx<width do begin
BitBlt(Dc,cx,cy,imgClient.Width,imgClient.Height,imgClient.Canvas.Handle,0,0,srccopy);
Inc(cx,imgClient.Width);
end;
cx:=0;
Inc(cy,imgClient.Height);
end;
finally
imgClient.Free;
end;
end;

//------------------------------------------------------------------------------
// 以下为非客户区消息
//------------------------------------------------------------------------------

//------------------------------------------------------------------------------
// 创建外边框
procedure THCForm.WMNCCreate(var Message : TWMNCCreate);
var
dwStyle : longInt;
begin
fCaptionHeight:= (GetSystemMetrics(SM_CYCAPTION))+CaptionMinHeightPattern;
dwStyle:= GetWindowLong(Handle, GWL_STYLE);
If (dwStyle and WS_DLGFRAME) = WS_DLGFRAME Then Begin
dwStyle:= dwStyle AND NOT longInt(WS_DLGFRAME);
SetWindowLong(Handle, GWL_STYLE, dwStyle);
End;

fMenuUp:= False; {Indicate the system menu is not showing}
fSysMenu:= TestWinStyle(WS_SYSMENU);
fMin:= TestWinStyle(WS_MINIMIZEBOX);
fMax:= TestWinStyle(WS_MAXIMIZEBOX);
fClose:= TestWinStyle(WS_SYSMENU);

inherited; {Call default processing.}
end;

//------------------------------------------------------------------------------
// 计算尺寸
procedure THCForm.WMNCCalcSize(var Message : TWMNCCalcSize);
begin
inherited; {Call default processing.}
If HasCaption and not IsIconic(Handle) Then Begin
Inc(Message.CalcSize_Params^.RgRc[0].Top, fCaptionHeight);
{If NOT Message.CalcValidRects Then Begin
End;}
End;
end;

//------------------------------------------------------------------------------
// 处理非工作区消息
procedure THCForm.WMNCHitTest(var Message : TWMNCHitTest);
var
rcCap,rcMenu,rcMin,rcMax,rcClose: TRect;
Point : TPoint;
begin
Inherited; {Call default processing.}
If (Message.Result = HTNOWHERE) AND HasCaption AND NOT IsIconic(Handle) Then Begin
GetCaptionRect(rcCap);
Point.X:=Message.Pos.X;
Point.Y:=Message.Pos.Y;
If PtInRect(rcCap, Point) Then Begin
Message.Result:= HTCAPTION;

GetCaptionButtonRect(HTSYSMENU,rcMenu);
Point.X:=Message.Pos.X;
Point.Y:=Message.Pos.Y;
If PtInRect(rcMenu, Point) Then Begin
Message.Result:= HTSYSMENU
End Else Begin
GetCaptionButtonRect(HTMINBUTTON,rcMin);
Point.X:=Message.Pos.X;
Point.Y:=Message.Pos.Y;
If PtInRect(rcMin, Point) then Begin
Message.Result:= HTMINBUTTON
End Else Begin
GetCaptionButtonRect(HTMAXBUTTON,rcMax);
Point.X:=Message.Pos.X;
Point.Y:=Message.Pos.Y;
If PtInRect(rcMax, Point) Then Begin
Message.Result:= HTMAXBUTTON;
End Else Begin
GetCaptionButtonRect(HTCLOSE,rcClose);
Point.X:=Message.Pos.X;
Point.Y:=Message.Pos.Y;
If PtInRect(rcClose, Point) Then Begin
Message.Result:= HTCLOSE;
End;
End;
End;
End;
End;
End;
If Message.Result <> HTSYSMENU Then Begin
fMenuUp := False; {Indicate the system menu is not showing}
End;
end;

procedure THCForm.WMNCLButtonDblClk(var Message : TWMNCLButtonDblClk);
begin
If (Message.HitTest = HTSYSMENU) AND HasCaption AND NOT IsIconic(Handle) Then
SendMessage(Handle, WM_CLOSE, 0, 0)
Else inherited; {Call default processing.}
end;

//------------------------------------------------------------------------------
// 处理左键消息
procedure THCForm.WMNCLButtonDown(var Message : TWMNCLButtonDown);
var
mPoint: TPoint;
begin
If HasCaption AND NOT IsIconic(Handle) Then Begin
mPoint:= Point(Message.XCursor, Message.YCursor);
Case Message.HitTest Of
HTSYSMENU: Begin
If NOT fMenuUp AND DoSysMenu Then
fMenuUp := True
Else fMenuUp := False;
End;
HTMINBUTTON: Begin
If DepressCaptionButton(HTMINBUTTON) Then
SendMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, longInt(@mPoint));
End;
HTMAXBUTTON: Begin
If DepressCaptionButton(HTMAXBUTTON) Then Begin
If IsZoomed(Handle) Then
SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, longInt(@mPoint))
Else SendMessage(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, longInt(@mPoint));
End;
End;
HTCLOSE: Begin
If DepressCaptionButton(HTCLOSE) Then Begin
SendMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, longInt(@mPoint));
End;
End;
Else Begin
inherited; {Call default processing.}
End;
End;
End Else Begin
inherited; {Call default processing.}
End;
end;

//------------------------------------------------------------------------------
// 绘制外边框
procedure THCForm.WMNCPaint(var Msg: TWMNCPaint);
var
dc : hDc;
Pen : hPen;
OldPen : hPen;
OldBrush : hBrush;
begin
inherited;
dc := GetWindowDC(Handle);
msg.Result := 1;
Pen := CreatePen(PS_SOLID, 4, Rgb(123,123,123));
OldPen := SelectObject(dc, Pen);
OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));
Rectangle(dc,0,0, Width, Height);
SelectObject(dc, OldBrush);
SelectObject(dc, OldPen);
DeleteObject(Pen);
ReleaseDC(Handle, Canvas.Handle);
end;

[smhpnuaa]

{ }
{ WMxxxx messages }
{ }
//------------------------------------------------------------------------------
procedure THCForm.WMPaint(var Message: TWMPaint);
var
DC: HDC;
PS: TPaintStruct;
begin
If NOT IsIconic(Handle) Then Begin
ControlState:= ControlState + [csCustomPaint];
DC:= BeginPaint(Handle, PS);
DrawWallpapper(DC);
EndPaint(Handle, PS);
ControlState:= ControlState - [csCustomPaint];
Message.Result:=0;
End Else
inherited;
end;

procedure THCForm.WMSize(var Message: TWMSize);
begin
Invalidate;
inherited;
end;

procedure THCForm.WMSysChar(var Message : TWMSysChar);
begin
If HasCaption AND (Message.CharCode = VK_SPACE) Then
DoSysMenu
Else inherited; {Call default processing.}
end;

procedure THCForm.WMCommand(var Message : TMessage);
begin
If Message.wParam >= $F000 Then
PostMessage(Handle, WM_SYSCOMMAND, Message.wParam, Message.lParam);
inherited; {Call default processing.}
end;

procedure THCForm.WMKeyDown(var Message : TWMKeyDown);
var
dwStyle : longInt;
begin
dwStyle := GetWindowLong(Handle, GWL_STYLE);
SetWindowLong(Handle, GWL_STYLE, dwStyle AND NOT longInt(WS_SYSMENU));
inherited; {Call default processing.}
SetWindowLong(Handle, GWL_STYLE, dwStyle);
end;

procedure THCForm.WMKeyUp(var Message : TWMKeyUp);
var
dwStyle : longInt;
begin
dwStyle := GetWindowLong(Handle, GWL_STYLE);
SetWindowLong(Handle, GWL_STYLE, dwStyle AND NOT longInt(WS_SYSMENU));
inherited; {Call default processing.}
SetWindowLong(Handle, GWL_STYLE, dwStyle);
end;

procedure THCForm.WMSysKeyDown(var Message : TWMSysKeyDown);
var
dwStyle : longInt;
begin
dwStyle := GetWindowLong(Handle, GWL_STYLE);
SetWindowLong(Handle, GWL_STYLE, dwStyle AND NOT longInt(WS_SYSMENU));
inherited; {Call default processing.}
SetWindowLong(Handle, GWL_STYLE, dwStyle);
end;

procedure THCForm.WMSysKeyUp(var Message : TWMSysKeyUp);
var
dwStyle : longInt;
begin
dwStyle := GetWindowLong(Handle, GWL_STYLE);
SetWindowLong(Handle, GWL_STYLE, dwStyle AND NOT longInt(WS_SYSMENU));
inherited; {Call default processing.}
SetWindowLong(Handle, GWL_STYLE, dwStyle);
end;

procedure THCForm.WMGetMinMaxInfo(var Message : TWMGetMinMaxInfo);
var
cX,cY: integer;
rcMenu,rcMin,rcMax,rcClose: TRect;
begin
If HasCaption and TestWinStyle(WS_THICKFRAME) Then Begin
{The following functions return empty rects. if box/button doesn't exist}
GetCaptionButtonRect(HTSYSMENU,rcMenu);
GetCaptionButtonRect(HTMINBUTTON,rcMin);
GetCaptionButtonRect(HTMAXBUTTON,rcMax);
GetCaptionButtonRect(HTCLOSE,rcClose);

cX := (rcMenu.Right - rcMenu.Left) +
(rcMin.Right - rcMin.Left) +
(rcMax.Right - rcMax.Left) +
(rcClose.Right - rcClose.Left);
cY := GetSystemMetrics(SM_CYFRAME);

With Message.MinMaxInfo^.ptMinTrackSize do begin
x := cX + 2 * fCaptionHeight;
y := fCaptionHeight + 2 * cY - 1;
End;
End;
end;

//------------------------------------------------------------------------------
//构造函数
constructor THCForm.Create(Owner: TComponent);
begin
inherited Create(Owner);
Color:= clHCMidGreen;
SetWindowLong(Handle,GWL_EXSTYLE,GetWindowLong(Handle, GWL_EXSTYLE) AND (NOT WS_EX_STATICEDGE));
DoubleBuffered:=True; //使用双缓冲
end;

//------------------------------------------------------------------------------
//析构函数
destructor THCForm.Destroy;
begin
inherited Destroy;
end;
end.

雅龙工作室欢迎你加盟，我们的宗旨：谁剥削无产阶级，我们剥削谁？
雅龙工作室欢迎你加盟，我们的宗旨：谁剥削无产阶级，我们剥削谁？
雅龙工作室欢迎你加盟，我们的宗旨：谁剥削无产阶级，我们剥削谁？
雅龙工作室欢迎你加盟，我们的宗旨：谁剥削无产阶级，我们剥削谁？
雅龙工作室欢迎你加盟，我们的宗旨：谁剥削无产阶级，我们剥削谁？
雅龙工作室欢迎你加盟，我们的宗旨：谁剥削无产阶级，我们剥削谁？
雅龙工作室欢迎你加盟，我们的宗旨：谁剥削无产阶级，我们剥削谁？
雅龙工作室欢迎你加盟，我们的宗旨：谁剥削无产阶级，我们剥削谁？
雅龙工作室欢迎你加盟，我们的宗旨：谁剥削无产阶级，我们剥削谁？

[shizhoubo]

真是好东东呀！GAO ！BUY！

[jiezhi]

gz

[D_Q]

smhpnuaa(农奴翻身感谢党) 好象不提倡共享控件呀 呵呵~~

[twself]

smhpnuaa(农奴翻身感谢党) ,SUPERMAN,I 服了U~~~~~~~~~

[RealAqing]

很想看看