高分求:如何在Bitmap上画半透明的Bitmap或写半透明的字?

yancey 2005-06-15 12:32:14
我要做Com+组件,实现网站上传图片自动加水印的功能,已实现加不透明Logo,但嫌不好看,请问如何在Bitmap上加半透明的水印效果?
...全文
336 8 打赏 收藏 转发到动态 举报
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
yancey 2005-07-06
  • 打赏
  • 举报
回复
运行时出错。。
yancey 2005-06-25
  • 打赏
  • 举报
回复
不太明白,不过先试试再说,来晚了不好意思,如果可用立刻加分,呵呵
纯冰糖 2005-06-18
  • 打赏
  • 举报
回复
Mark,Study
jinjazz 2005-06-18
  • 打赏
  • 举报
回复
这么多注释都不够么?
fansnaf 2005-06-18
  • 打赏
  • 举报
回复
呵呵,不错,
zwjchina 2005-06-18
  • 打赏
  • 举报
回复
呵呵,你可以去google搜索一下 “Alpha混合”
ihsgnep 2005-06-17
  • 打赏
  • 举报
回复
楼上讲点理论知识,说说原理,一堆代码好难看得懂,
在下知识有限
jinjazz 2005-06-15
  • 打赏
  • 举报
回复
unit Unit1;

interface

uses
Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Windows, jpeg, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image3: TImage;
Image2: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
procedure BlendPic(hBmp,hBmp2,hDC,Proportion :Integer);
implementation

{$R *.dfm}
type

TFColor=record
b,g,r: Byte;
end;

TLine=array[0..0]of TFColor;
PLine=^TLine;

var
Handle, Handle2,
Width,Height: Integer;
Bits,Bits2: Pointer;
BmpHeader: TBITMAPINFOHEADER;
BmpInfo: TBITMAPINFO;
RGB1:array of TFColor ;
RGB2:array of TFColor ;

procedure SetLine(y:Integer;Line,Line2:Pointer);
begin
CopyMemory( Pointer(Integer(Bits)+(y*(Width mod 4))+((y*Width)*3)),
Line,Width*3);

CopyMemory(Pointer(Integer(Bits2)+(y*(Width mod 4))+((y*Width)*3)),
Line2,Width*3);
end;

procedure GetScanLine(y:Integer;Line,Line2:Pointer);
begin
CopyMemory(Line,
Pointer(Integer(Bits)+(y*(Width mod 4))+((y*Width)*3)),
Width*3);
CopyMemory(Line2,
Pointer(Integer(Bits2)+(y*(Width mod 4))+((y*Width)*3)),
Width*3);
end;

procedure CreateFromhWnd(hBmp,hBmp2:Integer);
var Bmp: TBITMAP;
hDC: Integer;
begin
//为专门设备创建设备场景
hDC:=CreateDC('DISPLAY',nil,nil,nil);
//DISPLAY 获取整个屏幕
//每个设备场景都可能有选入其中的图形对象。
SelectObject(hDC,hBmp);
//设备场景的句柄; 位图句柄
//取得对指定对象进行说明的一个结构。
GetObject(hBmp,SizeOf(Bmp),@Bmp);
//位图句柄;长度; 位图BITMAP
Width:= Bmp.bmWidth;
Height:=Bmp.bmHeight;

with BmpHeader do
begin
biSize:=SizeOf(BmpHeader);
biWidth:=Width;
biHeight:=- Height;
biPlanes:=1;
biBitCount:=24;
biCompression:=BI_RGB;
end;
BmpInfo.bmiHeader:=BmpHeader;

Handle:=CreateDIBSection(0,BmpInfo,
DIB_RGB_COLORS,
Bits,0,0);
Handle2:=CreateDIBSection(0,BmpInfo,
DIB_RGB_COLORS,
Bits2,0,0);

//将来自一幅位图的二进制位复制到一幅与设备无关的位图里
GetDIBits(hDC, //设备场景的句柄
hBmp, //源位图的句柄。
0, //欲复制到DIB中的第一条扫描线的编号
Height, //欲复制的扫描线数量
Bits, //指向一个缓冲区的指针。
BmpInfo, //BITMAPINFO,对lpBits DIB的格式及颜色进行说明的一个结构。
DIB_RGB_COLORS); //在颜色表中装载RGB颜色
GetDIBits(hDC,
hBmp2,
0,
Height,
Bits2,
BmpInfo,
DIB_RGB_COLORS);

DeleteDC(hDC); //删除专用设备场景或信息场景
end;

procedure BlendPic(hBmp,hBmp2,hDC,Proportion :Integer);
var x,y : Integer;
Line,Line2: PLine;
p,p2:Single;
begin
CreateFromhWnd(hBmp,hBmp2);
GetMem(Line,Width*3);
GetMem(Line2,Width*3);

p2:= Proportion/5;
p:=2-p2;
for y:=0 to Height-1 do
begin
GetScanLine(y,Line,Line2);
for x:=0 to Width-1 do
begin
Line^[x].r:= Trunc((Line^[x].r*p + Line2^[x].r*p2) / 2) ;
Line^[x].g:= Trunc((Line^[x].g*p + Line2^[x].g*p2) / 2 ) ;
Line^[x].b:= Trunc((Line^[x].b*p + Line2^[x].b*p2) / 2 ) ;
end;
SetLine(y,Line,Line2);
end;
FreeMem(Line,Width*3); //释放内存
FreeMem(Line2,Width*3);

SetDIBitsToDevice(hDC, //设备场景的句柄。该场景用于接收位图数据
0,0, //用逻辑坐标表示的目标矩形的起点
Width,Height, //用目标矩形的设备单位表示的宽度及高度
0,0, //用设备坐标表示的源矩形在DIB中的起点
0, //Bits数组中第一条扫描线的编号。
Height, //欲复制的扫描线数量
Bits , //指向一个缓冲区的指针
BmpInfo, //BITMAPINFO,对Bits DIB的格式和颜色进行描述的一个结构
DIB_RGB_COLORS); //颜色表包含了RGB颜色

DeleteObject(Handle); //删除GDI对象
DeleteObject(Handle2);

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Image3.Picture:= Image2.Picture;

// for j:=0 to 99 do
BlendPic(Image1.Picture.Bitmap.Handle,Image2.Picture.Bitmap.Handle,
Image3.Picture.Bitmap.Canvas.Handle ,5);
end;

end.

1,183

社区成员

发帖
与我相关
我的任务
社区描述
Delphi GAME,图形处理/多媒体
社区管理员
  • GAME,图形处理/多媒体社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧