来点实用的，自己画带标题栏窗体，可当模态窗体…

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Menus;
type
TForm1 = class(TForm)
img1: TImage; //left
img2: TImage; //Top
img3: TImage; //Caption
img4: TImage; //Right
img5: TImage; //Time Control
imgmin: TImage; //Minbutton
imgrestore: TImage; //RestoreSize
imgMax: TImage; //Maxbutton
imgclose: TImage; //Closebutton

//这些图片是WINBLANDS 4里面的CHIRSTMASTIME的窗口样式图片，修改一下就更完美了

//修改完后用PHOTOSHOP转为256色（100%）OK，开始把图片载入各IMAGE控件，准备开始
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
iStyle: Longint; //窗口样式
shuai: boolean; //状态的判断标志，用在NCMOUSEMOVE里
procedure DrawActivate; //活动时这样画
procedure DrawDeActivate; //不活动就这样画
protected
procedure wndproc(var message: Tmessage); override;//事实上下面的也都是OVERRIDE，这里我只处理

//了非NC开头的一个消息，你也可以自己照下面的样式写WM_ACTIVATE
procedure wmnchittest(var msg: TWMNCHITTEST); message WM_NCHITTEST;
procedure wmncmousemove(var msg: TWMNcMousemove); message wm_ncmousemove;
procedure wmnclbuttondown(var msg: Twmnclbuttondown); message wm_nclbuttondown;
procedure wmnclbuttondblclk(var msg: TWMNCLButtonDblClk); message wm_nclbuttondblclk;
procedure wmnclbuttonup(var msg: twmnclbuttonup); message wm_nclbuttonup;
procedure wmncpaint(var msg: twmncpaint); message wm_ncpaint;
public
{ Public declarations }

end;

var
Form1 : TForm1;
caprect : TRect;
pt : TPoint;
dci : integer;
implementation

{$R *.dfm}
//------------------------------------------------------------------------------
procedure TForm1.FormResize(Sender: TObject);
var
rgn : HRGN;
begin
//要保证窗口的外观效果，设置一下
Form1.Constraints.MinHeight := 40;
Form1.Constraints.MaxHeight := getsystemmetrics(SM_CYSCREEN) - getsystemmetrics(SM_CYMIN);

rgn := CreateRoundRectRgn(0, 0, width, height, 5, 5);
//这里的RGN，主要是应付WINDOWS XP的主题文件的，不要它，嘿，真TMD丑
setwindowrgn(handle, rgn, true);//设置窗口区域并重画，区域外的绘制不会显示

deleteobject(rgn); //用完了记得删除对象。
invalidate; //这句也很重要哦
end;
//------------------------------------------------------------------------------
//活动时这样画
//------------------------------------------------------------------------------
procedure TForm1.DrawActivate;
var
myhdc : HDC;
ico : HICON;
i : integer;
cav : TCanvas;
ACV : TCanvas;
caprect : TRect;
rcdw : integer;
j : integer;
K : integer;
begin
// canvas.Lock;

myhdc := getwindowDc(handle);
ACV := TCanvas.Create;
try
ACV.handle := myhdc;
setstretchbltmode(ACV.handle, STRETCH_DELETESCANS);
with ACV do
begin
Bitblt(ACV.handle, 0, 0, 4, 31, img1.canvas.handle, 0, 0, SRCcopy);
//左上角的那么点，宽4像素，高31像素 SRCxxxxx还有很多的哦
Bitblt(ACV.handle, 4, 0, 30, 31, img2.canvas.handle, 0, 0, SRCcopy);
//Draw Icon//马上就要画图标了，我们来给它准备好位置吧
ico := Icon.handle; //想偷懒就这样。^-^
Drawiconex(ACV.handle, 18, 6, ico, 16, 16, 0, 0, DI_Normal);
//这上面的画ICON也可以给很多朋友参考的，这样画就是和原来的ICON一样的，闪烁？没有
//好了，ICON画好了，我们要开始画标题文字了，先准备下,不然怎么知道画多少呢
i := Length(Caption) * 8 - 10;
//每个文字大概、怎么也差不多有8像素宽的吧
Bitblt(ACV.handle, 34, 0, 6, 31, img3.canvas.handle, 0, 0, SRCcopy);
//下面准备为CAPTION铺上红地毯，~新郎新娘入洞房啦--“扑通”一块砖头飞来，我晕~倒
stretchblt(ACV.handle, 40, 0, i, 31, img3.canvas.handle, 6, 0, 10, 31, SRCcopy);
//开始画CAPTION了，这里应该有许多朋友想解决的问题的参考
cav := TCanvas.Create;
cav.Brush.Style := bsclear;
cav.handle := myhdc;
caprect := rect(45, 10, i * 2 - 20, 26);
cav.Font.Name := ''''宋体'''';

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有