实例介绍
【实例简介】Delphi简单DirectUI界面源码Unicode版
【实例截图】
【核心代码】
unit CometSkin;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ShellApi, AxCtrls, ActiveX, GDIPUTIL, GDIPAPI, GDIPOBJ;
const
SCM_NULL = 0;
SCM_MINIMIZE = -1; {标题栏_最小化按钮}
SCM_MAXIMIZE = -2; {标题栏_最大化按钮}
SCM_RESTORE = -3; {标题栏_还原按钮}
SCM_CLOSE = -4; {标题栏_关闭按钮}
SCM_MAINMENU = -5; {标题栏_主菜单按钮}
//未公开消息
WM_NCUAHDRAWCAPTION = $00AE;
WM_NCUAHDRAWFRAME = $00AF;
//自定义消息
WM_SkinControl_Click = WM_APP 100; {控件被点击}
WM_SkinControl_SYSClick = WM_APP 101; {控件被点击}
type
SkinControlType = (SCT_NULL, SCT_SYSBUTTON, SCT_MODULEBUTTON);
PSkinControl = ^TSkinControl;
TSkinControl = packed record
SCType: SkinControlType;
CtlID: Integer;
x, y, Width, Height: Integer;
Rect: TRect;
Caption: string;
WCaption: WideString;
wstrLength: Integer;
Image: TGPImage;
bImage: Boolean;
bHover, bPressed, bDisable, bCheck: Boolean;
end;
SkinControlArray = array of TSkinControl;
TSkinForm = class(TForm)
public
//设置窗口背景颜色
procedure SetBkColor(bkColor: Tcolor; bReDraw: Boolean = True);
overload;
procedure SetBkColor(r, g, b: Byte; bReDraw: Boolean = True); overload;
//设置窗口背景图片
procedure SetBkImage(ResName, ResType: string; NineX, NineY, NineWidth,
NineHeight: Integer);
//重绘整个窗口
procedure ReDrawWindow();
//添加模块按钮 (控件ID,按钮标题,资源图片名称,资源类型)
procedure AddModuleButton(CtlID: Integer; Caption, ResName, ResType:
string);
//选中某个模块
procedure SetModuleCheck(CtlID: Integer);
private
{ Private declarations }
procedure WMCreate(var Message: TWMCreate); message WM_CREATE;
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message
WM_NCCALCSIZE;
procedure WMMouseMove(var Message: TWMMouse); message WM_MOUSEMOVE;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WMLButtonDown(var Message: TWMMouse); message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TWMMouse); message WM_LBUTTONUP;
procedure WMControlClick(var msg: TMessage); message
WM_SkinControl_SYSClick;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
procedure WMNCActivate(var Message: TWMNCActivate); message
WM_NCACTIVATE;
procedure WMNCUAHDrawCaption(var msg: TMessage); message
WM_NCUAHDRAWCAPTION;
procedure WMNCUAHDrawFrame(var msg: TMessage); message
WM_NCUAHDRAWFRAME;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message
WM_ERASEBKGND;
{
procedure WMCtlColor(var Message: TWMCtlColor); message WM_CTLCOLOR;
procedure WMCtlColorBtn(var Message: TWMCtlColorBtn); message
WM_CTLCOLORBTN;
procedure WMCtlColorDlg(var Message: TWMCtlColorDlg); message
WM_CTLCOLORDLG;
procedure WMCtlColorEdit(var Message: TWMCtlColorEdit); message
WM_CTLCOLOREDIT;
procedure WMCtlColorListbox(var Message: TWMCtlColorListbox); message
WM_CTLCOLORLISTBOX;
procedure WMCtlColorMsgbox(var Message: TWMCtlColorMsgbox); message
WM_CTLCOLORMSGBOX;
procedure WMCtlColorScrollbar(var Message: TWMCtlColorScrollbar); message
WM_CTLCOLORSCROLLBAR;
procedure WMCtlColorStatic(var Message: TWMCtlColorStatic); message
WM_CTLCOLORSTATIC; }
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMGetMinMaxInfo(var msg: TWMGetMinMaxInfo); message
WM_GETMINMAXINFO;
procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
function CopySkin(hWndDC: HDC): Boolean;
function DrawWindow(): Boolean;
function DrawBackground(): Boolean;
function DrawControls(): Boolean;
function DrawControl(const graphics: TGPGraphics; nIndex: Integer):
Boolean;
procedure DrawControlEx(nIndex: Integer);
function DrawControl_SysBtn(const graphics: TGPGraphics; const Control:
TSkinControl): Boolean;
function DrawControl_Module(const graphics: TGPGraphics; const Control:
TSkinControl): Boolean;
function CreateControl(SCType: SkinControlType; x, y, Width, Height:
Integer; CtlID: Integer = 0): Integer;
procedure MoveControl(nIndex, x, y: Integer; Width: Integer = -1;
Height: Integer = -1);
procedure SetControlImage(nIndex: Integer; ResName, ResType: string);
procedure SetControlText(nIndex: Integer; strText: string);
function GetSysButton(CtlID: Integer): Integer;
procedure SetHoverControl(nIndex: Integer = -1);
procedure SetPressedControl(nIndex: Integer = -1);
function GetHoverIndex(pt: TPoint): Integer;
procedure DisableSysTheme();
procedure DrawNineRect(const graphics: TGPGraphics); overload;
procedure DrawNineRect(const graphics: TGPGraphics; const image:
TGPImage; DestRect, SrcRect, NineRect: TRect); overload;
procedure DrawNineRect(const graphics: TGPGraphics; const image:
TGPImage; x, y, w, h, srcx, srcy, srcw, srch: Integer); overload;
function CreateRoundPath(x, y, w, h, cornerRadius: Single):
TGPGraphicsPath;
protected
{私有成员变量}
m_hWnd: HWND;
m_hCacheDC, m_hBackDC: HDC;
m_hCacheBitmap, m_hOldCacheBitmap: HBITMAP;
m_hBackBitmap, m_hOldBackBitmap: HBITMAP;
m_nWidth, m_nHeight: integer;
m_bkColor, m_BorderColor1, m_BorderColor2: TGPColor;
m_bkImage: TGPImage;
m_bkNineRect: TGPRect;
m_bkIsImage: Boolean;
m_hIcon: HICON;
m_hFont, m_hBoldFont: HFONT;
m_bIsZoomed: Boolean;
m_ControlArray: SkinControlArray;
m_ControlCount: Integer;
m_ControlSysCount: Integer;
m_HoverIndex, m_PressedIndex: Integer;
m_bTracking: Boolean;
m_ModuleLeft: Integer;
m_ModuleFont: TGPFont;
m_ModuleFormat: TGPStringFormat;
m_ModuleBrush: TGPSolidBrush;
procedure CreateParams(var Params: TCreateParams); override;
public
{ Public declarations }
end;
implementation
procedure TSkinForm.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
//params.Style := params.Style and (not WS_CAPTION);
params.ExStyle := params.ExStyle and (not WS_EX_DLGMODALFRAME);
params.ExStyle := params.ExStyle and (not WS_EX_WINDOWEDGE);
params.ExStyle := params.ExStyle and (not WS_EX_CLIENTEDGE);
Params.WindowClass.Style := CS_VREDRAW or CS_HREDRAW or CS_OWNDC;
//Params.WinClassName := 'CometSkinForm';
end;
procedure TSkinForm.WMCreate(var Message: TWMCreate);
var
buf: array[0..MAX_PATH] of Char;
FileInfo: SHFILEINFO;
lf: TLogFontW;
plf: PLogFontW;
dc: HDC;
begin
m_hWnd := Handle;
m_bkColor := MakeColor(50, 150, 190);
m_bkIsImage := False;
m_BorderColor1 := MakeColor(150, 0, 0, 0);
m_BorderColor2 := MakeColor(150, 255, 255, 255);
m_hFont := GetStockObject(DEFAULT_GUI_FONT);
GetObject(m_hFont, SizeOf(lf), @lf);
lf.lfWeight := FW_BOLD;
m_hBoldFont := CreateFontIndirectW(lf);
m_hIcon := SendMessage(m_hWnd, WM_GETICON, ICON_SMALL, 0);
if m_hIcon = 0 then
begin
GetModuleFileName(0, buf, Length(buf));
SHGetFileInfo(buf, 0, FileInfo, SizeOf(FileInfo), SHGFI_SMALLICON or
SHGFI_ICON);
m_hIcon := FileInfo.hIcon;
end;
//-----------------------
dc := GetDC(0);
plf := @lf;
m_ModuleFont := TGPFont.Create(dc, plf);
ReleaseDC(0, dc);
m_ModuleFormat := TGPStringFormat.Create();
m_ModuleFormat.SetAlignment(StringAlignmentCenter);
m_ModuleFormat.SetLineAlignment(StringAlignmentCenter);
m_ModuleBrush := TGPSolidBrush.Create(MakeColor(255, 255, 255));
//-----------------------
m_bTracking := False;
m_HoverIndex := -1;
m_PressedIndex := -1;
m_ControlCount := 0;
m_ModuleLeft := 7;
CreateControl(SCT_SYSBUTTON, 300, 5, 30, 19, SCM_MAINMENU);
CreateControl(SCT_SYSBUTTON, 300, 5, 30, 19, SCM_MINIMIZE);
CreateControl(SCT_SYSBUTTON, 350, 5, 30, 19, SCM_MAXIMIZE);
CreateControl(SCT_SYSBUTTON, 400, 5, 39, 19, SCM_CLOSE);
m_ControlSysCount := m_ControlCount;
//-----------------------
inherited;
DisableSysTheme();
SetWindowPos(m_hWnd, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOOWNERZORDER or
SWP_NOMOVE or SWP_NOSIZE);
end;
procedure TSkinForm.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
//inherited;
//修改非客户区(标题栏、窗口边框)尺寸
if Message.CalcValidRects then
begin
Message.CalcSize_Params^.rgrc[2] := Message.CalcSize_Params^.rgrc[1];
Message.CalcSize_Params^.rgrc[1] := Message.CalcSize_Params^.rgrc[0];
end
else
begin
end;
Message.Result := 1;
end;
procedure TSkinForm.WMSize(var Message: TWMSize);
begin
if m_hCacheDC <> 0 then
begin
SelectObject(m_hCacheDC, m_hOldCacheBitmap);
SelectObject(m_hBackDC, m_hOldBackBitmap);
DeleteDC(m_hCacheDC);
DeleteDC(m_hBackDC);
DeleteObject(m_hCacheBitmap);
DeleteObject(m_hBackBitmap);
m_hCacheDC := 0;
m_hBackDC := 0;
m_hCacheBitmap := 0;
m_hBackBitmap := 0;
end;
inherited;
end;
procedure TSkinForm.WMGetMinMaxInfo(var msg: TWMGetMinMaxInfo);
var
MyScreen: TScreen;
Monitor: TMonitor;
rc: TRect;
begin
if IsZoomed(m_hWnd) then
begin
MyScreen := TScreen.Create(nil);
Monitor := MyScreen.MonitorFromWindow(m_hWnd);
rc := Monitor.WorkareaRect;
msg.MinMaxInfo.ptMaxPosition.X := rc.Left;
msg.MinMaxInfo.ptMaxPosition.Y := rc.Top;
msg.MinMaxInfo.ptMaxSize.X := rc.right - rc.left;
msg.MinMaxInfo.ptMaxSize.Y := rc.bottom - rc.top;
//SetWindowPos(m_hWnd,0,rc.Left,rc.Top,rc.right-rc.left,rc.bottom-rc.top,SWP_NOZORDER);
msg.Result := 0;
inherited;
end
else
begin
inherited;
end;
end;
procedure TSkinForm.WMActivate(var Message: TWMActivate);
var
rc: TRect;
w, h: integer;
begin
Windows.GetClientRect(m_hWnd, rc);
inherited;
w := rc.Right - rc.Left;
h := rc.Bottom - rc.Top;
//SetWindowPos(m_hWnd,0,0,0,w 1,h 1,SWP_FRAMECHANGED or SWP_NOREDRAW Or SWP_NOOWNERZORDER Or SWP_NOMOVE);
//SetWindowPos(m_hWnd,0,0,0,w,h,SWP_FRAMECHANGED or SWP_DRAWFRAME Or SWP_NOOWNERZORDER Or SWP_NOMOVE);
//InvalidateRect(m_hWnd, nil, False);
end;
procedure TSkinForm.WMMouseMove(var Message: TWMMouse);
var
e: TTrackMouseEvent;
nIndex: Integer;
pt: TPoint;
begin
inherited;
if m_bTracking = False then
begin
m_bTracking := True;
E.cbSize := SIZEof(TTrackMouseEvent);
E.dwFlags := TME_LEAVE;
E.dwHoverTime := 10;
E.hwndTrack := m_hWnd;
trackmouseevent(e);
end;
pt.x := Message.XPos;
pt.y := Message.YPos;
nIndex := GetHoverIndex(pt);
SetHoverControl(nIndex);
end;
procedure TSkinForm.CMMouseLeave(var Message: TMessage);
begin
inherited;
m_bTracking := False;
SetPressedControl(-1);
SetHoverControl(-1);
end;
procedure TSkinForm.WMLButtonDown(var Message: TWMMouse);
var
nIndex: Integer;
pt: TPoint;
begin
inherited;
pt.x := Message.XPos;
pt.y := Message.YPos;
nIndex := GetHoverIndex(pt);
SetPressedControl(nIndex);
if nIndex = -1 then
begin
ReleaseCapture();
PostMessage(m_hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
end;
procedure TSkinForm.WMLButtonUp(var Message: TWMMouse);
var
nIndex, nOldIndex: Integer;
pt: TPoint;
Control: TSkinControl;
begin
inherited;
pt.x := Message.XPos;
pt.y := Message.YPos;
nIndex := GetHoverIndex(pt);
nOldIndex := m_PressedIndex;
SetPressedControl(-1);
if (nIndex >= 0) and (nIndex < m_ControlCount) then
begin
ReleaseCapture();
Application.ProcessMessages;
Control := m_ControlArray[nIndex];
Windows.PostMessage(m_hWnd, WM_SkinControl_SYSClick, Control.CtlID,
nIndex);
end;
end;
procedure TSkinForm.WMControlClick(var msg: TMessage);
var
nIndex: Integer;
CtlID: Integer;
Control: TSkinControl;
bMsg: Boolean;
begin
nIndex := msg.LParam;
CtlID := msg.WParam;
bMsg := False;
if (nIndex >= 0) and (nIndex < m_ControlCount) then
begin
Control := m_ControlArray[nIndex];
if Control.SCType = SCT_SYSBUTTON then
begin
if (CtlID = SCM_MAXIMIZE) and IsZoomed(m_hWnd) then
begin
CtlID := SCM_RESTORE;
end;
case CtlID of
SCM_MINIMIZE:
PostMessage(m_hWnd, WM_SYSCOMMAND, SC_MINIMIZE, 0);
SCM_MAXIMIZE:
PostMessage(m_hWnd, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
SCM_RESTORE:
PostMessage(m_hWnd, WM_SYSCOMMAND, SC_RESTORE, 0);
SCM_CLOSE:
PostMessage(m_hWnd, WM_SYSCOMMAND, SC_CLOSE, 0);
SCM_MAINMENU:
bMsg := True;
end;
end
else
begin
bMsg := True;
end;
if bMsg then
begin
Windows.PostMessage(m_hWnd, WM_SkinControl_Click, CtlID, nIndex);
end;
end;
end;
procedure TSkinForm.WMPaint(var Message: TWMPaint);
var
ps: PAINTSTRUCT;
dc: HDC;
begin
dc := BeginPaint(handle, ps);
CopySkin(dc);
EndPaint(handle, ps);
Message.Result := 0;
end;
procedure TSkinForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
CopySkin(Message.DC);
Message.Result := 1;
end;
procedure TSkinForm.WMNCPaint(var Message: TWMNCPaint);
var
dc: HDC;
begin
dc := GetWindowDC(m_hWnd);
//CopySkin(dc);
ReleaseDC(m_hWnd, dc);
Message.Result := 0;
end;
procedure TSkinForm.WMNCActivate(var Message: TWMNCActivate);
begin
//在这里不能调用默认的处理因为当窗口是非激活状态时会画出默认的Title
//inherited;
Message.Result := 1;
end;
procedure TSkinForm.WMNCUAHDrawCaption(var msg: TMessage);
begin
//这两条消息是在xp sp2后加的.xp在以前有个bug在某些时候Titlebar会画错.
//在这里不能调用默认处理，直接自绘nc区.;
end;
procedure TSkinForm.WMNCUAHDrawFrame(var msg: TMessage);
begin
//这两条消息是在xp sp2后加的.xp在以前有个bug在某些时候Titlebar会画错.
//在这里不能调用默认处理，直接自绘nc区.;
end;
{
procedure TSkinForm.WMCtlColor(var Message: TWMCtlColor);
begin
inherited;
end;
procedure TSkinForm.WMCtlColorBtn(var Message: TWMCtlColorBtn);
begin
inherited;
end;
procedure TSkinForm.WMCtlColorDlg(var Message: TWMCtlColorDlg);
begin
inherited;
end;
procedure TSkinForm.WMCtlColorEdit(var Message: TWMCtlColorEdit);
begin
inherited;
end;
procedure TSkinForm.WMCtlColorListbox(var Message: TWMCtlColorListbox);
begin
inherited;
end;
procedure TSkinForm.WMCtlColorMsgbox(var Message: TWMCtlColorMsgbox);
begin
inherited;
end;
procedure TSkinForm.WMCtlColorScrollbar(var Message: TWMCtlColorScrollbar);
begin
inherited;
end;
procedure TSkinForm.WMCtlColorStatic(var Message: TWMCtlColorStatic);
var
pt: TPoint;
rtControl: TRect;
begin
if m_hBackDC <> 0 then
begin
inherited;
//pt.X:=0;
//pt.Y:=0;
//MapWindowPoints(Message.ChildWnd,m_hWnd,pt,1);
//Windows.GetClientRect(Message.ChildWnd,rtControl);
//BitBlt(Message.ChildDC, 0, 0,rtControl.Right-rtControl.Left, rtControl.Bottom-rtControl.Top, m_hCacheDC,pt.X, pt.Y, SRCCOPY);
//SetTextColor(Message.ChildDC,$FFFFFF) ;
//Message.Result:=GetStockObject(NULL_BRUSH);
end
else
begin
inherited;
end;
end;
}
function TSkinForm.CopySkin(hWndDC: HDC): Boolean;
begin
if m_hCacheDC = 0 then
begin
DrawWindow();
end;
BitBlt(hWndDC, 0, 0, m_nWidth, m_nHeight, m_hCacheDC, 0, 0, SRCCOPY);
end;
function TSkinForm.DrawWindow(): Boolean;
var
hSrcDC: HDC;
rc: TRect;
nWidth, nHeight: integer;
Rgn: HRGN;
begin
m_bIsZoomed := Windows.IsZoomed(m_hWnd);
Windows.GetClientRect(m_hWnd, rc);
nWidth := rc.Right - rc.Left;
nHeight := rc.Bottom - rc.Top;
m_nWidth := nWidth;
m_nHeight := nHeight;
hSrcDC := GetDC(m_hWnd);
m_hCacheDC := CreateCompatibleDC(hSrcDC);
m_hBackDC := CreateCompatibleDC(hSrcDC);
m_hCacheBitmap := CreateCompatibleBitmap(hSrcDC, nWidth, nHeight);
m_hBackBitmap := CreateCompatibleBitmap(hSrcDC, nWidth, nHeight);
m_hOldCacheBitmap := SelectObject(m_hCacheDC, m_hCacheBitmap);
m_hOldBackBitmap := SelectObject(m_hBackDC, m_hBackBitmap);
//--------------------------------------------
SetBkMode(m_hCacheDC, TRANSPARENT);
SetBkMode(m_hBackDC, TRANSPARENT);
//--------------------------------------------
ReleaseDC(m_hWnd, hSrcDC);
DrawBackground();
DrawControls();
//--------------------------------------------
if m_bIsZoomed then
begin
Rgn := CreateRectRgn(0, 0, m_nWidth, m_nHeight);
end
else
begin
Rgn := CreateRoundRectRgn(0, 0, m_nWidth 1, m_nHeight 1, 4, 4);
end;
SetWindowRgn(m_hWnd, Rgn, False);
DeleteObject(Rgn);
result := True;
end;
function TSkinForm.DrawBackground(): Boolean;
var
g: TGPGraphics;
b: TGPSolidBrush;
Pen1, Pen2: TGPPen;
path1, path2: TGPGraphicsPath;
x, y, w, h, cornerRadius, len: Integer;
buf: array[0..MAX_PATH] of Char;
hOldFont: HFONT;
rc: TRect;
rcF, SrcF: TGPRectF;
w1, w2, w3: Single;
begin
//----------------
g := TGPGraphics.Create(m_hBackDC);
b := TGPSolidBrush.Create(m_bkColor);
g.FillRectangle(b, 0, 0, m_nWidth, m_nHeight);
b.Free;
//----------------
if m_bkIsImage then
begin
w := m_bkImage.GetWidth();
h := m_bkImage.GetHeight();
end
else
begin
w := 0;
h := 0;
end;
if (w > 0) and (h > 0) then
begin
if (m_nWidth <= w) and (m_nHeight <= h) then
begin
rcF := MakeRect(0.0, 0.0, m_nWidth, m_nHeight);
SrcF := MakeRect(w - m_nWidth, 0.0, m_nWidth, m_nHeight);
g.DrawImage(m_bkImage, rcF, SrcF.X, SrcF.Y, SrcF.Width, SrcF.Height,
UnitPixel);
end
else if (m_bkNineRect.Width > 0) and (m_bkNineRect.Height > 0) then
begin
//按九宫图绘制
DrawNineRect(g);
end;
end;
//----------------
Pen1 := TGPPen.Create(m_BorderColor1);
Pen2 := TGPPen.Create(m_BorderColor2);
if m_bIsZoomed then
begin
g.DrawRectangle(Pen1, 0, 0, m_nWidth - 1, m_nHeight - 1);
g.DrawRectangle(Pen2, 1, 1, m_nWidth - 3, m_nHeight - 3);
end
else
begin
x := 0;
Y := 0;
w := m_nWidth - 1;
h := m_nHeight - 1;
cornerRadius := 3;
path1 := TGPGraphicsPath.Create();
path1.AddArc(x, y, cornerRadius * 2, cornerRadius * 2, 180, 90); //左上
path1.AddArc(x w - cornerRadius * 2, y, cornerRadius * 2, cornerRadius
* 2, 270, 90); //右上
path1.AddArc(x w - cornerRadius * 2, y h - cornerRadius * 2,
cornerRadius * 2, cornerRadius * 2, 0, 90); //右下
path1.AddArc(x, y h - cornerRadius * 2, cornerRadius * 2, cornerRadius
* 2, 90, 90); //左下
path1.CloseFigure();
g.DrawPath(Pen1, path1);
path1.Free;
x := 1;
Y := 1;
w := m_nWidth - 3;
h := m_nHeight - 3;
cornerRadius := 3;
path2 := TGPGraphicsPath.Create();
path2.AddArc(x, y, cornerRadius * 2, cornerRadius * 2, 180, 90); //左上
path2.AddArc(x w - cornerRadius * 2, y, cornerRadius * 2, cornerRadius
* 2, 270, 90); //右上
path2.AddArc(x w - cornerRadius * 2, y h - cornerRadius * 2,
cornerRadius * 2, cornerRadius * 2, 0, 90); //右下
path2.AddArc(x, y h - cornerRadius * 2, cornerRadius * 2, cornerRadius
* 2, 90, 90); //左下
path2.CloseFigure();
g.DrawPath(Pen2, path2);
path2.Free;
end;
Pen1.Free;
Pen2.Free;
//----------------
//绘制图标
x := 5;
y := 5;
w := 16;
h := 16;
if m_hIcon <> 0 then
begin
DrawIconEx(m_hBackDC, x, y, m_hIcon, w, h, 0, 0, DI_NORMAL);
x := x 20;
end;
//----------------
//绘制标题
rc.Left := x;
rc.Top := y;
rc.Right := m_nWidth - 100;
rc.Bottom := y h;
GetWindowText(m_hWnd, buf, MAX_PATH);
hOldFont := SelectObject(m_hBackDC, m_hBoldFont);
SetTextColor(m_hBackDC, $333333);
DrawText(m_hBackDC, buf, -1, rc, DT_SINGLELINE or DT_VCENTER);
OffsetRect(rc, -1, -1);
SetTextColor(m_hBackDC, $FFFFFF);
DrawText(m_hBackDC, buf, -1, rc, DT_SINGLELINE or DT_VCENTER);
SelectObject(m_hBackDC, hOldFont);
//----------------
g.Free;
result := True;
end;
function TSkinForm.DrawControls(): Boolean;
var
i, x, y, nIndex: Integer;
g: TGPGraphics;
begin
BitBlt(m_hCacheDC, 0, 0, m_nWidth, m_nHeight, m_hBackDC, 0, 0, SRCCOPY);
g := TGPGraphics.Create(m_hCacheDC);
//g.SetSmoothingMode(SmoothingModeAntiAlias);
g.SetInterpolationMode(InterpolationModeHighQualityBicubic);
//----------------
x := m_nWidth - 2;
y := 2;
nIndex := GetSysButton(SCM_CLOSE);
if nIndex > -1 then
begin
x := x - m_ControlArray[nIndex].Width;
MoveControl(nIndex, x, y);
end;
nIndex := GetSysButton(SCM_MAXIMIZE);
if nIndex > -1 then
begin
x := x - m_ControlArray[nIndex].Width;
MoveControl(nIndex, x, y);
end;
nIndex := GetSysButton(SCM_MINIMIZE);
if nIndex > -1 then
begin
x := x - m_ControlArray[nIndex].Width;
MoveControl(nIndex, x, y);
end;
nIndex := GetSysButton(SCM_MAINMENU);
if nIndex > -1 then
begin
x := x - m_ControlArray[nIndex].Width;
MoveControl(nIndex, x, y);
end;
//----------------
for i := 0 to m_ControlCount - 1 do
begin
DrawControl(g, i);
end;
//----------------
g.Free;
result := True;
end;
function TSkinForm.DrawControl(const graphics: TGPGraphics; nIndex: Integer):
Boolean;
var
Control: TSkinControl;
begin
Control := m_ControlArray[nIndex];
case Control.SCType of
SCT_SYSBUTTON:
DrawControl_SysBtn(graphics, Control);
SCT_MODULEBUTTON:
DrawControl_Module(graphics, Control);
end;
result := True;
end;
//画出顶部模块按钮
function TSkinForm.DrawControl_Module(const graphics: TGPGraphics; const
Control: TSkinControl): Boolean;
var
x, y, w, h: Single;
cornerRadius: Integer;
rc: TGPRectF;
c1, c2, c3, c4: TGPColor;
Pen1, Pen2, Pen3: TGPPen;
Brush: TGPSolidBrush;
path1, path2, path3: TGPGraphicsPath;
SmoothingMode: TSmoothingMode;
begin
//画出背景 ========================
if Control.bCheck or Control.bPressed or Control.bHover then
begin
if Control.bCheck or Control.bPressed = True then
begin
c1 := MakeColor(20, 0, 0, 0);
c2 := MakeColor(60, 0, 0, 0);
c3 := MakeColor(120, 255, 255, 255);
c4 := MakeColor(70, 255, 255, 255);
end
else
begin
c1 := MakeColor(15, 0, 0, 0);
c2 := MakeColor(40, 0, 0, 0);
c3 := MakeColor(90, 255, 255, 255);
c4 := MakeColor(50, 255, 255, 255);
end;
Pen1 := TGPPen.Create(c1);
Pen2 := TGPPen.Create(c2);
Pen3 := TGPPen.Create(c3);
Brush := TGPSolidBrush.Create(c4);
x := Control.x;
y := Control.y;
w := Control.Width - 2;
h := Control.Height - 2;
path1 := CreateRoundPath(x, y, w, h, 5);
path2 := CreateRoundPath(x 1, y 1, w - 2, h - 2, 5);
path3 := CreateRoundPath(x 2, y 2, w - 4, h - 4, 5);
SmoothingMode := graphics.GetSmoothingMode();
graphics.SetSmoothingMode(SmoothingModeAntiAlias);
graphics.DrawPath(Pen1, path1);
graphics.DrawPath(Pen2, path2);
graphics.FillPath(Brush, path3);
graphics.DrawPath(Pen3, path3);
graphics.SetSmoothingMode(SmoothingMode);
Pen1.Free;
Pen2.Free;
Pen3.Free;
Brush.Free;
path1.Free;
path2.Free;
path3.Free;
end;
//画出图标 ========================
if Control.bImage then
begin
w := Control.Image.GetWidth();
h := Control.Image.GetHeight();
rc.Width := w;
rc.Height := h;
if rc.Width > 48 then
rc.Width := 48;
if rc.Height > 48 then
rc.Height := 48;
rc.X := Control.x (Control.Width - rc.Width) / 2;
rc.y := Control.y (Control.Height - rc.Height - 20) / 2;
graphics.DrawImage(Control.Image, rc, 0, 0, w, h, UnitPixel);
end;
//画出文字 ========================
if Control.wstrLength > 0 then
begin
Brush := TGPSolidBrush.Create(MakeColor(60, 0, 0, 0));
rc := MakeRect(Control.x 1, Control.y 1 Control.Height - 20,
Control.Width - 1, 18.0);
graphics.DrawString(Control.WCaption, -1, m_ModuleFont, rc,
m_ModuleFormat, Brush);
rc.x := rc.x - 1;
rc.y := rc.y - 1;
graphics.DrawString(Control.WCaption, -1, m_ModuleFont, rc,
m_ModuleFormat, m_ModuleBrush);
Brush.Free;
end;
//--------------------------
result := True;
end;
//画出系统按钮(最小化、最大化...)
function TSkinForm.DrawControl_SysBtn(const graphics: TGPGraphics; const
Control: TSkinControl): Boolean;
var
path1, IconPath, IconPath2: TGPGraphicsPath;
IconBrush: TGPSolidBrush;
IconPen: TGPPen;
LineBrush1, LineBrush2: TGPLinearGradientBrush;
x, y, w, h: Single;
i, CtlID: Integer;
rc: TGPRectF;
c1, c2: TGPColor;
begin
CtlID := Control.CtlID;
if (CtlID = SCM_MAXIMIZE) and m_bIsZoomed then
begin
CtlID := SCM_RESTORE;
end;
//画出背景 ========================
if Control.bPressed or Control.bHover then
begin
x := Control.x 1;
y := Control.y;
w := Control.Width - 1;
h := Control.Height;
if Control.CtlID = SCM_CLOSE then
begin
if Control.bPressed = True then
begin
c1 := MakeColor(180, 128, 0, 0);
c2 := MakeColor(0, 0, 0, 0);
end
else
begin
c1 := MakeColor(180, 255, 0, 0);
c2 := MakeColor(0, 0, 0, 0);
end;
end
else
begin
w := w - 2;
if Control.bPressed = True then
begin
c1 := MakeColor(90, 0, 0, 0);
c2 := MakeColor(0, 0, 0, 0);
end
else
begin
c1 := MakeColor(60, 255, 255, 255);
c2 := MakeColor(0, 255, 255, 255);
end;
end;
rc := MakeRect(x, y, 1, h);
LineBrush1 := TGPLinearGradientBrush.Create(rc, c1, c2,
LinearGradientModeVertical);
rc := MakeRect(x, y, w, h);
graphics.FillRectangle(LineBrush1, rc);
rc.X := rc.X - 1;
LineBrush2 := TGPLinearGradientBrush.Create(rc, c1, c2,
LinearGradientModeVertical);
graphics.FillRectangle(LineBrush2, rc);
LineBrush1.Free();
LineBrush2.Free();
end;
//画出图标 ========================
w := 11;
h := 9;
x := Control.x ((Control.Width - w) / 2) - 1;
y := Control.y ((Control.Height - h) / 2) - 1;
IconPath := TGPGraphicsPath.Create();
IconPath.SetFillMode(FillModeWinding);
case CtlID of
SCM_MINIMIZE:
begin
rc.x := integer(Trunc(x));
rc.Y := integer(Trunc(y)) integer(Trunc(h)) - 2;
rc.Width := integer(Trunc(w));
rc.Height := 2;
IconPath.AddRectangle(rc);
end;
SCM_MAXIMIZE:
begin
h := 8;
y := y 1;
rc.x := integer(Trunc(x));
rc.Y := integer(Trunc(y));
rc.Width := integer(Trunc(w));
rc.Height := 2;
IconPath.AddRectangle(rc);
rc.Y := integer(Trunc(y)) integer(Trunc(h)) - 1;
rc.Height := 1;
IconPath.AddRectangle(rc);
rc.Y := integer(Trunc(y));
rc.Width := 1;
rc.Height := integer(Trunc(h));
IconPath.AddRectangle(rc);
rc.x := integer(Trunc(x)) integer(Trunc(w)) - 1;
IconPath.AddRectangle(rc);
end;
SCM_RESTORE:
begin
w := 12;
h := 8;
y := y 1;
x := x - 1;
rc := MakeRect(x 2, y 0.0, 10, 1);
IconPath.AddRectangle(rc);
rc := MakeRect(x 2, y 0.0, 1, 2);
IconPath.AddRectangle(rc);
rc := MakeRect(x 11, y 0.0, 1, 6);
IconPath.AddRectangle(rc);
rc := MakeRect(x 9, y 6, 3, 1);
IconPath.AddRectangle(rc);
rc := MakeRect(x, y 2, 10, 2);
IconPath.AddRectangle(rc);
rc := MakeRect(x, y 2, 1, 6);
IconPath.AddRectangle(rc);
rc := MakeRect(x 9, y 2, 1, 6);
IconPath.AddRectangle(rc);
rc := MakeRect(x, y 7, 10, 1);
IconPath.AddRectangle(rc);
end;
SCM_CLOSE:
begin
for i := 0 to 8 do
begin
rc.x := integer(Trunc(x)) i;
rc.Y := integer(Trunc(y)) i;
rc.Width := 3;
rc.Height := 1;
IconPath.AddRectangle(rc);
rc.x := integer(Trunc(x)) integer(Trunc(w)) - i - 3;
IconPath.AddRectangle(rc);
end;
end;
SCM_MAINMENU:
begin
rc.x := integer(Trunc(x));
rc.Y := integer(Trunc(y));
rc.Width := integer(Trunc(w));
rc.Height := 2;
IconPath.AddRectangle(rc);
rc.Y := integer(Trunc(y)) integer(Trunc(h)) - 1;
rc.Height := 1;
IconPath.AddRectangle(rc);
rc.Y := integer(Trunc(y));
rc.Width := 1;
rc.Height := integer(Trunc(h));
IconPath.AddRectangle(rc);
rc.x := integer(Trunc(x)) integer(Trunc(w)) - 1;
IconPath.AddRectangle(rc);
rc.Width := 1;
rc.Height := 1;
rc.Y := integer(Trunc(y)) integer(Trunc(h)) - 3;
rc.X := integer(Trunc(x)) ((w - rc.Width) / 2);
IconPath.AddRectangle(rc);
rc.Width := 3;
rc.Y := rc.Y - rc.Height;
rc.X := integer(Trunc(x)) ((w - rc.Width) / 2);
IconPath.AddRectangle(rc);
rc.Width := 5;
rc.Y := rc.Y - rc.Height;
rc.X := integer(Trunc(x)) ((w - rc.Width) / 2);
IconPath.AddRectangle(rc);
end;
end;
IconPath.CloseAllFigures();
IconPath2 := TGPGraphicsPath.Create(IconPath);
IconBrush := TGPSolidBrush.Create(MakeColor(255, 255, 255));
IconPen := TGPPen.Create(MakeColor(50, 0, 0, 0));
IconPath.Widen(IconPen);
graphics.DrawPath(IconPen, IconPath);
IconPath.Widen(IconPen);
graphics.DrawPath(IconPen, IconPath);
graphics.FillPath(IconBrush, IconPath2);
IconPath.Free;
IconPath2.Free;
IconPen.Free;
IconBrush.Free;
//画出分割线 ========================
if Control.CtlID <> SCM_CLOSE then
begin
x := Control.x Control.Width - 1;
y := Control.y;
rc := MakeRect(x, y, 1, Control.Height);
c1 := MakeColor(120, 255, 255, 255);
c2 := MakeColor(0, 255, 255, 255);
LineBrush1 := TGPLinearGradientBrush.Create(rc, c1, c2,
LinearGradientModeVertical);
graphics.FillRectangle(LineBrush1, rc);
rc.X := rc.X - 1;
c1 := MakeColor(90, 0, 0, 0);
c2 := MakeColor(0, 0, 0, 0);
LineBrush2 := TGPLinearGradientBrush.Create(rc, c1, c2,
LinearGradientModeVertical);
graphics.FillRectangle(LineBrush2, rc);
LineBrush1.Free();
LineBrush2.Free();
end;
//--------------------------
result := True;
end;
function TSkinForm.CreateControl(SCType: SkinControlType; x, y, Width, Height:
Integer; CtlID: Integer = 0): Integer;
var
nIndex: Integer;
begin
SetLength(m_ControlArray, m_ControlCount 1);
nIndex := m_ControlCount;
m_ControlCount := Length(m_ControlArray);
m_ControlArray[nIndex].SCType := SCType;
m_ControlArray[nIndex].CtlID := CtlID;
m_ControlArray[nIndex].bHover := False;
m_ControlArray[nIndex].bPressed := False;
m_ControlArray[nIndex].bDisable := False;
m_ControlArray[nIndex].bCheck := False;
m_ControlArray[nIndex].bImage := False;
MoveControl(nIndex, x, y, Width, Height);
result := nIndex;
end;
procedure TSkinForm.MoveControl(nIndex, x, y: Integer; Width: Integer = -1;
Height: Integer = -1);
begin
m_ControlArray[nIndex].x := x;
m_ControlArray[nIndex].y := y;
if Width > -1 then
m_ControlArray[nIndex].Width := Width;
if Height > -1 then
m_ControlArray[nIndex].Height := Height;
m_ControlArray[nIndex].Rect.Left := x;
m_ControlArray[nIndex].Rect.Top := y;
m_ControlArray[nIndex].Rect.Right := x m_ControlArray[nIndex].Width;
m_ControlArray[nIndex].Rect.Bottom := y m_ControlArray[nIndex].Height;
end;
function TSkinForm.GetSysButton(CtlID: Integer): Integer;
var
nIndex, i: Integer;
begin
nIndex := -1;
for i := 0 to m_ControlSysCount - 1 do
begin
if m_ControlArray[i].CtlID = CtlID then
begin
nIndex := i;
break;
end;
end;
result := nIndex;
end;
procedure TSkinForm.SetBkColor(bkColor: Tcolor; bReDraw: Boolean = True);
begin
m_bkColor := ColorRefToARGB(bkColor);
if bReDraw then
ReDrawWindow();
end;
procedure TSkinForm.SetBkColor(r, g, b: Byte; bReDraw: Boolean = True);
begin
m_bkColor := MakeColor(r, g, b);
if bReDraw then
ReDrawWindow();
end;
//设置窗口背景图片
procedure TSkinForm.SetBkImage(ResName, ResType: string; NineX, NineY,
NineWidth, NineHeight: Integer);
var
hMod: HMODULE;
HRes: HRSRC;
sResName: string;
sResType: string;
Len: DWORD;
lpRsrc: PByte;
m_hMem: HGLOBAL;
pMem: PByte;
pstm: IStream;
begin
m_bkNineRect := MakeRect(NineX, NineY, NineWidth, NineHeight);
if m_bkIsImage then
begin
m_bkImage.destroy();
m_bkImage.Free();
m_bkIsImage := False;
end;
hMod := GetModuleHandle(nil);
sResName := ResName;
sResType := ResType;
HRes := FindResource(HInstance, PChar(sResName), PChar(sResType));
if HRes <> 0 then
begin
Len := SizeofResource(HInstance, HRes);
lpRsrc := PByte(LoadResource(HInstance, HRes));
try
if lpRsrc <> nil then
begin
m_hMem := GlobalAlloc(GMEM_FIXED, Len);
pMem := Pbyte(GlobalLock(m_hMem));
CopyMemory(pMem, lpRsrc, Len);
CreateStreamOnHGlobal(m_hMem, False, pstm);
m_bkImage := TGPImage.Create(pstm);
m_bkIsImage := True;
GlobalUnlock(m_hMem);
pstm := nil;
FreeResource(Dword(lpRsrc));
end;
except
end;
end;
ReDrawWindow();
end;
procedure TSkinForm.ReDrawWindow();
begin
if (IsWindowVisible(m_hWnd)) and (IsIconic(m_hWnd) = False) then
begin
DrawWindow();
InvalidateRect(m_hWnd, nil, False);
end;
end;
procedure TSkinForm.DrawControlEx(nIndex: Integer);
var
Control: TSkinControl;
g: TGPGraphics;
dc: HDC;
begin
if (nIndex >= 0) and (nIndex < m_ControlCount) then
begin
Control := m_ControlArray[nIndex];
BitBlt(m_hCacheDC, Control.x, Control.y, Control.Width, Control.Height,
m_hBackDC, Control.x, Control.y, SRCCOPY);
g := TGPGraphics.Create(m_hCacheDC);
g.SetInterpolationMode(InterpolationModeHighQualityBicubic);
//--------------
DrawControl(g, nIndex);
//--------------
dc := GetDC(m_hWnd);
BitBlt(dc, Control.x, Control.y, Control.Width, Control.Height,
m_hCacheDC, Control.x, Control.y, SRCCOPY);
ReleaseDC(m_hWnd, dc);
end;
end;
procedure TSkinForm.SetHoverControl(nIndex: Integer = -1);
var
nOldIndex: Integer;
begin
if m_HoverIndex <> nIndex then
begin
nOldIndex := m_HoverIndex;
m_HoverIndex := nIndex;
if (nOldIndex > -1) and (nOldIndex < m_ControlCount) then
begin
m_ControlArray[nOldIndex].bHover := False;
DrawControlEx(nOldIndex);
end;
if (nIndex >= 0) and (nIndex < m_ControlCount) then
begin
m_ControlArray[nIndex].bHover := True;
DrawControlEx(nIndex);
end;
end;
end;
procedure TSkinForm.SetPressedControl(nIndex: Integer = -1);
var
nOldIndex: Integer;
begin
if m_PressedIndex <> nIndex then
begin
nOldIndex := m_PressedIndex;
m_PressedIndex := nIndex;
if (nOldIndex >= 0) and (nOldIndex < m_ControlCount) then
begin
m_ControlArray[nOldIndex].bPressed := False;
DrawControlEx(nOldIndex);
end;
if (nIndex >= 0) and (nIndex < m_ControlCount) then
begin
m_ControlArray[nIndex].bPressed := True;
DrawControlEx(nIndex);
end;
end;
end;
function TSkinForm.GetHoverIndex(pt: TPoint): Integer;
var
nIndex, i: Integer;
begin
nIndex := -1;
for i := 0 to m_ControlCount - 1 do
begin
if PtInRect(m_ControlArray[i].Rect, pt) then
begin
nIndex := i;
break;
end;
end;
result := nIndex;
end;
procedure TSkinForm.DisableSysTheme();
var
Module: HMODULE;
dwAttr: DWORD;
lpSetWindowTheme: function(hWnd: HWND; a, b: Integer): Integer; StdCall;
lpDwmSetWindowAttribute: function(hWnd: HWND; dwAttribute: DWORD;
pvAttribute: LPDWORD; cbAttribute: DWORD): Integer; StdCall;
begin
//防止xp 、vista、win7 用主题绘制窗口nc区
//vista、win7厚边框问题解决办法
Module := GetModuleHandle('UxTheme.dll');
if Module = 0 then
Module := LoadLibrary('UxTheme.dll');
if Module <> 0 then
begin
@lpSetWindowTheme := GetProcAddress(Module, 'SetWindowTheme');
lpSetWindowTheme(m_hWnd, 0, 0);
end;
Module := GetModuleHandle('dwmapi.dll');
if Module = 0 then
Module := LoadLibrary('dwmapi.dll');
if Module <> 0 then
begin
dwAttr := 1;
@lpDwmSetWindowAttribute := GetProcAddress(Module,
'DwmSetWindowAttribute');
lpDwmSetWindowAttribute(m_hWnd, 2, @dwAttr, 4);
end;
end;
procedure TSkinForm.DrawNineRect(const graphics: TGPGraphics);
var
DestRect, SrcRect, NineRect: TRect;
begin
DestRect.Left := 0;
DestRect.Top := 0;
DestRect.Right := m_nWidth;
DestRect.Bottom := m_nHeight;
SrcRect.Left := 0;
SrcRect.Top := 0;
SrcRect.Right := m_bkImage.GetWidth();
SrcRect.Bottom := m_bkImage.GetHeight();
NineRect.Left := m_bkNineRect.X;
NineRect.Top := m_bkNineRect.Y;
NineRect.Right := m_bkNineRect.X m_bkNineRect.Width;
NineRect.Bottom := m_bkNineRect.y m_bkNineRect.Height;
DrawNineRect(graphics, m_bkImage, DestRect, SrcRect, NineRect);
end;
procedure TSkinForm.DrawNineRect(const graphics: TGPGraphics; const image:
TGPImage; DestRect, SrcRect, NineRect: TRect);
var
x, y, nWidth, nHeight: Integer;
xSrc, ySrc, nSrcWidth, nSrcHeight: Integer;
nDestWidth, nDestHeight: Integer;
begin
//g.DrawImage(m_bkImage,rcF,SrcF.X,SrcF.Y,SrcF.Width,SrcF.Height,UnitPixel);
nDestWidth := DestRect.right - DestRect.left;
nDestHeight := DestRect.bottom - DestRect.top;
nDestWidth := DestRect.right - DestRect.left;
nDestHeight := DestRect.bottom - DestRect.top;
// 左上-------------------------------------;
x := DestRect.left;
y := DestRect.top;
nWidth := NineRect.left - SrcRect.left;
nHeight := NineRect.top - SrcRect.top;
xSrc := SrcRect.left;
ySrc := SrcRect.top;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nWidth,
nHeight);
// 上-------------------------------------;
x := DestRect.left NineRect.left - SrcRect.left;
nWidth := nDestWidth - nWidth - (SrcRect.right - NineRect.right);
xSrc := NineRect.left;
nSrcWidth := NineRect.right - NineRect.left;
nSrcHeight := NineRect.top - SrcRect.top;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nSrcWidth,
nSrcHeight);
// 右上-------------------------------------;
x := DestRect.right - (SrcRect.right - NineRect.right);
nWidth := SrcRect.right - NineRect.right;
xSrc := NineRect.right;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nWidth,
nHeight);
// 左-------------------------------------;
x := DestRect.left;
y := DestRect.top NineRect.top - SrcRect.top;
nWidth := NineRect.left - SrcRect.left;
nHeight := DestRect.top nDestHeight - y - (SrcRect.bottom -
NineRect.bottom);
xSrc := SrcRect.left;
ySrc := NineRect.top;
nSrcWidth := NineRect.left - SrcRect.left;
nSrcHeight := NineRect.bottom - NineRect.top;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nSrcWidth,
nSrcHeight);
// 中-------------------------------------;
x := DestRect.left NineRect.left - SrcRect.left;
nWidth := nDestWidth - nWidth - (SrcRect.right - NineRect.right);
xSrc := NineRect.left;
nSrcWidth := NineRect.right - NineRect.left;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nSrcWidth,
nSrcHeight);
// 右-------------------------------------;
x := DestRect.right - (SrcRect.right - NineRect.right);
nWidth := SrcRect.right - NineRect.right;
xSrc := NineRect.right;
nSrcWidth := SrcRect.right - NineRect.right;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nSrcWidth,
nSrcHeight);
// 左下-------------------------------------;
x := DestRect.left;
y := DestRect.top nDestHeight - (SrcRect.bottom - NineRect.bottom);
nWidth := NineRect.left - SrcRect.left;
nHeight := SrcRect.bottom - NineRect.bottom;
xSrc := SrcRect.left;
ySrc := NineRect.bottom;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nWidth,
nHeight);
// 下-------------------------------------;
x := DestRect.left NineRect.left - SrcRect.left;
nWidth := nDestWidth - nWidth - (SrcRect.right - NineRect.right);
xSrc := NineRect.left;
nSrcWidth := NineRect.right - NineRect.left;
nSrcHeight := SrcRect.bottom - NineRect.bottom;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nSrcWidth,
nSrcHeight);
// 右下-------------------------------------;
x := DestRect.right - (SrcRect.right - NineRect.right);
nWidth := SrcRect.right - NineRect.right;
xSrc := NineRect.right;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nWidth,
nHeight);
end;
procedure TSkinForm.DrawNineRect(const graphics: TGPGraphics; const image:
TGPImage; x, y, w, h, srcx, srcy, srcw, srch: Integer);
var
RcF, SrcF: TGPRectF;
begin
RcF.X := x;
RcF.Y := y;
RcF.Width := w;
RcF.Height := h;
SrcF.X := Srcx;
SrcF.Y := Srcy;
SrcF.Width := Srcw;
SrcF.Height := Srch;
graphics.DrawImage(image, rcF, SrcF.X, SrcF.Y, SrcF.Width, SrcF.Height,
UnitPixel);
end;
procedure TSkinForm.AddModuleButton(CtlID: Integer; Caption, ResName, ResType:
string);
var
nIndex: Integer;
begin
nIndex := CreateControl(SCT_MODULEBUTTON, m_ModuleLeft, 24, 72, 76, CtlID);
m_ModuleLeft := m_ModuleLeft m_ControlArray[nIndex].Width 5;
SetControlText(nIndex, Caption);
SetControlImage(nIndex, ResName, ResType);
end;
procedure TSkinForm.SetModuleCheck(CtlID: Integer);
var
i: Integer;
begin
for i := 0 to m_ControlCount - 1 do
begin
if m_ControlArray[i].SCType = SCT_MODULEBUTTON then
begin
if m_ControlArray[i].CtlID = CtlID then
begin
m_ControlArray[i].bCheck := True;
DrawControlEx(i);
end
else if m_ControlArray[i].bCheck then
begin
m_ControlArray[i].bCheck := False;
DrawControlEx(i);
end;
end;
end;
end;
procedure TSkinForm.SetControlText(nIndex: Integer; strText: string);
var
nLen: integer;
begin
if (nIndex < 0) or (nIndex >= m_ControlCount) then
exit;
m_ControlArray[nIndex].Caption := strText;
//----------------------
if strText = '' then
begin
m_ControlArray[nIndex].WCaption := '';
m_ControlArray[nIndex].wstrLength := 0;
end
else
begin
m_ControlArray[nIndex].WCaption := strText;
m_ControlArray[nIndex].wstrLength := Length(strText);
{nLen := MultiByteToWideChar(936, 1, PChar(@strText[1]), -1, nil, 0);
SetLength(m_ControlArray[nIndex].WCaption, nLen - 1);
if nLen > 1 then
MultiByteToWideChar(936, 1, PChar(@strText[1]), -1,
PWideChar(@m_ControlArray[nIndex].WCaption[1]), nLen - 1);
m_ControlArray[nIndex].wstrLength := nLen;}
end;
end;
procedure TSkinForm.SetControlImage(nIndex: Integer; ResName, ResType: string);
var
hMod: HMODULE;
HRes: HRSRC;
sResName: string;
sResType: string;
Len: DWORD;
lpRsrc: PByte;
m_hMem: HGLOBAL;
pMem: PByte;
pstm: IStream;
begin
if (nIndex < 0) or (nIndex >= m_ControlCount) then
exit;
if m_ControlArray[nIndex].bImage then
begin
m_ControlArray[nIndex].Image.destroy();
m_ControlArray[nIndex].Image.Free();
m_ControlArray[nIndex].bImage := False;
end;
hMod := GetModuleHandle(nil);
sResName := ResName;
sResType := ResType;
HRes := FindResource(HInstance, PChar(sResName), PChar(sResType));
if HRes <> 0 then
begin
Len := SizeofResource(HInstance, HRes);
lpRsrc := PByte(LoadResource(HInstance, HRes));
try
if lpRsrc <> nil then
begin
m_hMem := GlobalAlloc(GMEM_FIXED, Len);
pMem := Pbyte(GlobalLock(m_hMem));
CopyMemory(pMem, lpRsrc, Len);
CreateStreamOnHGlobal(m_hMem, False, pstm);
m_ControlArray[nIndex].Image := TGPImage.Create(pstm);
m_ControlArray[nIndex].bImage := True;
GlobalUnlock(m_hMem);
pstm := nil;
FreeResource(Dword(lpRsrc));
end;
except
end;
end;
end;
function TSkinForm.CreateRoundPath(x, y, w, h, cornerRadius: Single):
TGPGraphicsPath;
var
path1: TGPGraphicsPath;
begin
path1 := TGPGraphicsPath.Create();
path1.AddArc(x, y, cornerRadius * 2, cornerRadius * 2, 180, 90); //左上
path1.AddArc(x w - cornerRadius * 2, y, cornerRadius * 2, cornerRadius
* 2, 270, 90); //右上
path1.AddArc(x w - cornerRadius * 2, y h - cornerRadius * 2,
cornerRadius * 2, cornerRadius * 2, 0, 90); //右下
path1.AddArc(x, y h - cornerRadius * 2, cornerRadius * 2, cornerRadius
* 2, 90, 90); //左下
path1.CloseFigure();
result := path1;
end;
end.
好例子网口号：伸出你的我的手 — 分享！
小贴士
感谢您为本站写下的评论，您的评论对其它用户来说具有重要的参考价值，所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字，对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙，所以请不要反馈意义不大的重复字符，也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明，或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦，又没人会搭理，于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享，对搜索内容的合法性不具有预见性、识别性、控制性，仅供学习研究，请务必在下载后24小时内给予删除，不得用于其他任何用途，否则后果自负。基于互联网的特殊性，平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查；无论平台是否已进行审查，用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场，基于网友分享，根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定，若资源存在侵权或相关问题请联系本站客服人员，点此联系我们。关于更多版权及免责申明参见 版权及免责申明
网友评论
我要评论