Delphi做异型窗体PNG透明
{*******************************************************}
{ }
{ 异形窗口 }
{ }
{ 2009.12.4 王 锐 }
{ }
{*******************************************************}
unit UnitYXForm;
interface
uses
Windows, Forms, Classes, Graphics;
//从文件加载PNG
procedure YXForm_FromFile(AForm : TForm; AFileName : String);
//从资源加载PNG
procedure YXForm_FromResource(AForm : TForm; ResName : String; ResType : PWideChar; Instance : HINST = 0);
//从图像对象加载
procedure YXForm_FromGraphic(AForm : TForm; AGraphic : TGraphic);
implementation
procedure YXForm_FromFile(AForm : TForm; AFileName : String);
var
wic : TWICImage;
begin
wic := TWICImage.Create;
wic.LoadFromFile(AFileName);
YXForm_FromGraphic(AForm, wic);
wic.Free;
end;
procedure YXForm_FromResource(AForm : TForm; ResName : String;ResType : PWideChar; Instance : HINST);
var
wic : TWICImage;
r : TResourceStream;
begin
if Instance = 0 then
Instance := HInstance;
r := TResourceStream.Create(Instance, ResName, ResType);
wic := TWICImage.Create;
wic.LoadFromStream(r);
YXForm_FromGraphic(AForm, wic);
wic.Free;
r.Free;
end;
procedure YXForm_FromGraphic(AForm : TForm; AGraphic : TGraphic);
var
ptDst, ptSrc: TPoint;
Size: TSize;
BlendFunction: TBlendFunction;
bmp : TBitmap;
begin
bmp := TBitmap.Create;
bmp.Assign(AGraphic);
ptDst := Point(AForm.Left, AForm.Top);
ptSrc := Point(0, 0);
Size.cx := AGraphic.Width;
Size.cy := AGraphic.Height;
BlendFunction.BlendOp := AC_SRC_OVER;
BlendFunction.BlendFlags := 0;
BlendFunction.SourceConstantAlpha := $FF; // 透明度
BlendFunction.AlphaFormat := AC_SRC_ALPHA;
SetWindowLong(AForm.Handle, GWL_EXSTYLE, GetWindowLong(AForm.Handle,
GWL_EXSTYLE) or WS_EX_LAYERED);
UpdateLayeredWindow(AForm.Handle,
AForm.Canvas.Handle,
@ptDst,
@Size,
bmp.Canvas.Handle,
@ptSrc,
0,
@BlendFunction,
ULW_ALPHA);
bmp.Free();
end;
end.
想要用的时候很简单,举个例子:
ff := TForm2.Create(Self);
YXForm_FromFile(ff, 'c:\a.png');
ff.Show;
实现动画也很容易.只要不停地YXForm_FromFile(ff, 'c:\a.png');调用一套动作PNG就可以了.
本文来自CSDN博客,转载请标明出处:http://blog.csdn.net/wr960204/archive/2009/12/04/4941660.aspx
Delphi做异型窗体PNG透明的更多相关文章
- 使窗体拥有透明效果的API
一.背景FlashGet的透明效果大家羡慕吧.传统的Windows应用程序想实现半透明效果,一般来说需要处理自己的窗口的WM_Paint消息窗口,很麻烦.现在好了,SetLayeredWindowAt ...
- Delphi中的窗体创建与销毁
Delphi中的窗体,有模式窗体与非模式窗体两种.两种窗体的调用方式不同,模式窗体使用ShowModal显示,非模式窗体使用Show显示.当显示模式窗体的时候你是不能操作本程序的其他窗体的,你不能把焦 ...
- 担心后端代码泄露?用delphi做后端,模板扣出来,随时可以变化。
担心后端代码泄露?用delphi做后端,模板扣出来,随时可以变化. 本项目不是intraweb, unigui等类似的拖拉项目,只是一个简单 的模板引擎,理论上可以结合任何后端. 要就下载源码,作者保 ...
- delphi SetWindowPos改变窗体位置和状态
http://blog.163.com/yuanliaofan@126/blog/static/1730690722012534428814/ delphi SetWindowPos改变窗体位置和状态 ...
- [原创] Delphi 修改新建窗体时候的默认字体格式
Delphi 修改新建窗体时候的默认字体格式 操作步骤: 1.运行输入“regedit” 2.找到目录(这里默认以Delphi 7为例) HKEY_CURRENT_USER\Software\Borl ...
- delphi判断MDI窗体的子窗体是否存在
转]delphi判断MDI窗体的子窗体是否存在//*************************************************************************** ...
- delphi制作登陆窗体
delphi登陆窗体的制作,就我知道的,可以有两种方法,一种是在工程文件中实现登陆窗体的动态调用,另一种就是在主窗体的OnCreate事件中动态创建登陆窗体,两种方法都需要将主窗体设置为Auto-cr ...
- Delphi 实现不规则窗体
最近为了要兼容XP系统(守旧的市场),又需要做出产品的特效,不得不从头学习一下这门 “聪明的语言” . 开发环境: win10 Delphi 10.2 Version 25.0.26309.314 产 ...
- JavaFX之FXML+CSS创建窗体以及透明窗体添加阴影
前言 开通博客园有一段日子了,一直没空也没想好该写点什么.最近正好在做一个桌面程序,初次接触JavaFX,体验下来确实比swing好用不少.索性便记记学习笔记吧,虽然FX好像挺没存在感,没人用的感觉. ...
随机推荐
- Unity HOME
{ https://unity.com/cn?_ga=2.134655153.1528856053.1574826116-818341090.1574826116 }
- CSV (逗号分隔值文件格式)
逗号分隔值(Comma-Separated Values,CSV,有时也称为字符分隔值,因为分隔字符也可以不是逗号),其文件以纯文本形式存储表格数据(数字和文本).纯文本意味着该文件是一个字符序列,不 ...
- 8、iota枚举
1.iota常量自动生成器,每一行,自动累加1 2.iota给常量赋值使用 3.如果iota遇到const,就会重置为0 4.可以可以只写一个iota 5.如果是同一行,值是一样的 // 09_iot ...
- Android中的surfaceHolder.lockCanvas(null)返回为null详解
对于新手学习SurfaceView的时候获取lockCanvas的时候总是返回null的问题很是纠结 canvas = surfaceHolder.lockCanvas(new Rect(0, 0, ...
- bzoj1066题解
[解题思路] 考虑拆点,把每根石柱拆成两个点,具体可以理解为石柱底部和石柱顶部,能爬到石柱顶部的蜥蜴只有有限只,而且蜥蜴只有爬到了石柱顶部才能跳到其他石柱的底部. 这样,考虑如下建图: 将每个有蜥蜴的 ...
- 为什么 Go 语言把类型放在后面
不是为了与众不同.而是为了更加清晰易懂. Rob Pike 曾经在 Go 官方博客解释过这个问题(原文地址:http://blog.golang.org/gos-declaration-syntax) ...
- VS2012编译WDM驱动
新版的VS2012中集成了WDK8,而且WDK8中已经没有之前的Build Environment了,看来编译驱动只能通过VS2012了,直接开发WDF驱动很方便直接选取相应的模板即可,若是编译以前的 ...
- ()centos7 安装python36
centos7 默认安装 python2.7 1.先安装python36和对应pip yum install python-pip #安装python2的pip yum install python3 ...
- python Pool并行执行
# -*- coding: utf-8 -*- import time from multiprocessing import Pool def run(fn): #fn: 函数参数是数据列表的一个元 ...
- XML 扩展部分
引入命名空间 xmlns DTD缺点 1.不支持命名空间 2.支持的数据类型很少 3.DTD不可扩展 4.DTD不遵循XML规范 DTD的优点 简洁 schema 通过schema来解决DTD的不足 ...