发现自己现在有了6000多可用分,过年了,散分,还带问个问题

lwk_hlj 2003-01-23 08:59:48
有图像特效的算法吗?
给贴出几个来
谢谢
...全文
125 75 打赏 收藏 转发到动态 举报
写回复
用AI写文章
75 条回复
切换为时间正序
请发表友善的回复…
发表回复
liaoqianlin 2003-01-23
  • 打赏
  • 举报
回复
强啊,哈哈....
抢分啊,
liutl1 2003-01-23
  • 打赏
  • 举报
回复
接分
zzheaptech 2003-01-23
  • 打赏
  • 举报
回复
接分
lwk_hlj 2003-01-23
  • 打赏
  • 举报
回复
先不结了,还有吗?
ohwww 2003-01-23
  • 打赏
  • 举报
回复
哦哦哦哦哦,厉害厉害啊,学习学习。高手不能做成控件类的东西吗?让我们菜鸟方便一下
yzykjh 2003-01-23
  • 打赏
  • 举报
回复
收藏
LKJ99 2003-01-23
  • 打赏
  • 举报
回复
gz
bluemeteor 2003-01-23
  • 打赏
  • 举报
回复
关于图像的一些讨论


--------------------------------------------------------------------------------


大富翁论坛版权所有
来自:crazycock, 时间:2002-1-5 20:46:00, ID:837114
目的:将一张BMP图像(简称A)的中间某个区域进行羽化,然后和另外一张BMP图(简称B)(例如一个像框的图象 ),然后让两张图像合并,让B的中间(即非像框区域)为透明,显示出A在这个区域中间,另外,A在B的中间 显示出来的内容的边缘是经过羽化的,并非直接拼在一起。
有以下几个问题:
1。如何实现BMP图中,规则区域边缘的羽化问题(就是说其中一块圆形或矩形的区域),无论控件实现或者自 己写代码都可。
2。如何实现图像透明的效果。(我认为可以这样考虑,让B图需要透明的地方用某个颜色,然后建立一个BMP图 C,在C图上写内容,从B图某个点开始读,如果B图中的某个点不是那个预先设定的“透明颜色”,那么就往C图 上填B的点,如果读到B图上某个点是“透明点”,那么就写对应位置A图的点的内容,不知道这样考虑是否合适 ??)
3。如何实现两个图像内容的颜色累加,也就是说两张图的累加效果?是直接将他们的RGB值累加吗?或者求平 均值??
4。控件我找了很多,大富翁里有关的问题我也找了,不过好象没有能够完全解决我的问题的答案,希望大家讨 论一下。

来自:vine, 时间:2002-1-5 20:52:00, ID:837123
》如何通过算法设置出象photoshop里一幅图象在另一幅图象上如何透明地显示,
并且可以设置透明度,如50%的透明度。并不是单幅图象的透明性。

Tbitmap有关的属性:
1.TansparentColor: 透明色;
2.PixelFormat:指明每一象点颜色所占的二进位数;
pf16bit: 点2字节;
pf24bit: 3字节;
pf32bit: 4字节;
3.ScanLine[行号];每一行象素缓冲的首址,即数组
的首址,每一象点占连续字节;

有了上面的3个属性,就可以写出合成2幅图象的算法;

算法:
for 第0行 到 最后一行
for 第0列 TO 最后一列
begin
1.取第一幅一个象点c1;
2.取第二幅一个象点c2;
3.如果c1是透明色,c3:=c2;
如果c2是透明色,c3:=c1;
4.送c3
end


我有个效率不高(速度很慢),但效果绝对好的算法:

for 第0行 到 最后一行
for 第0列 TO 最后一列
begin
1.取第一幅一个像点c1的R色 c1R;
2.取第二幅一个像点c2的R色 c2R;
3.新像点的R色 cR := (c1R*K+c2R*(1-K));

4.取第一幅一个像点c1的G色 c1G;
5.取第二幅一个像点c2的G色 c2G;
6.新像点的G色 cG := (c1G*K+c2G*(1-K));

7.取第一幅一个像点c1的B色 c1B;
8.取第二幅一个像点c2的B色 c2B;
9.新像点的B色 cB := (c1B*K+c2B*(1-K));

10.新像点的RGB色 cRGB := RGB(cR,cG,cB);

end

其中 K 是2个图合并时,第一幅图的权重。改变这个 K 值可以得到一个渐变的效果。


可将下面代码转换为DELPHI代码就可:

CDC memDC;
CBitmap &cBitmap=m_bmpDraw;
CBitmap* pOldMemBmp = NULL;
COLORREF col,colMask;
CRect cRect;
int x, y;
CRgn wndRgn, rgnTemp;

GetWindowRect(&cRect);
CPoint ptOrg=cRect.TopLeft();

BITMAP bmInfo;
cBitmap.GetObject(sizeof(bmInfo),&bmInfo);
CRect rcNewWnd=CRect(ptOrg,CSize(bmInfo.bmWidth,bmInfo.bmHeight));

memDC.CreateCompatibleDC(pDC);
pOldMemBmp = memDC.SelectObject(&cBitmap);
colMask=memDC.GetPixel(0,0);

wndRgn.CreateRectRgn(0, 0, rcNewWnd.Width(), rcNewWnd.Height());
for(x=0; x<=rcNewWnd.Width(); x++)
{
for(y=0; y<=rcNewWnd.Height(); y++)
{
col = memDC.GetPixel(x, y);
if(col == colMask)
{
rgnTemp.CreateRectRgn(x, y, x+1, y+1);
wndRgn.CombineRgn(&wndRgn, &rgnTemp, RGN_XOR);
rgnTemp.DeleteObject();
}
}
}
if (pOldMemBmp) memDC.SelectObject(pOldMemBmp);
SetWindowRgn((HRGN)wndRgn, TRUE);
MoveWindow(rcNewWnd);

呵呵!看来这些人没明白你的意思呀!我曾经研究过这个问题,不过我是用VC做的,不知道用DELPHI怎么做, 不过我可以把算法告诉你:取得两幅为图在每一点的像素值,分离出R,G,B的值,生成位图相应像素的R,G, B由下面公式决定:R=kR1+(1-k)R2 G=kG1+(1-k)G2 B=kB1+(1-k)B2 k为透明度,范围是0%-100% , R1,R2,G1,G2,B1,B2为混合的两幅位图分离出来的R,G,B值,R,G,B为混合后的相应像素的R,G,B值。
APIer(APIer) (2001-1-2 17:01:00) 得0分
使用DDraw吧,这是一个简单的Alpha特效啊。
nononono的方法是可行的,但是使用了太多的乘法,还要用到浮点,在16位位图游戏编程中,大家通常使用这 样的方法来进行Alpha混合:
1先分色并移位
2进行混色:(混色深度为32,足够了)
DestColor= (RscColor-DestColor)*Alpha_Depth〉〉5+DestColor;(R.G.B分别计算)
3最后合色
nononono(null,null) (2001-1-7 12:39:00) 得0分
akuan,这样试试:

分离RGB3色用"位与"、"移位"运算的方法;

透明的比例按 32、16分级。
如:如果是按32级,

A图的权重 K = n/32,则B图的权重 = (32-n)/32,
可以得到这样的算法:

cR := (c1R*n+c2R*(32-n));
再对cR右移4位。

这样的算法要快很多。

来自:YB_unique, 时间:2002-1-6 10:44:00, ID:837724
My God!问题好多啊!^_^
1。羽化就是色彩的平滑淡化处理。要卷老兄贴算法给你吧!
2。透明效果就是布尔运算而已,别想得太复杂!
3。颜色累加看你追求的效果而言,非得取平均值也无可非议。说来说去就是Blend。
4。不知道你是如何搜索论坛资源的,我的记忆中 2 和 3 在论坛里都有答案!

来自:卷起千堆雪tyn, 时间:2002-1-6 19:20:00, ID:838678
归结起来就是一个Alpha混合的问题!
留下MAIL,我发给你一个完整的例程,自己去研究;可以满足你的要求。


来自:卷起千堆雪tyn, 时间:2002-1-6 21:54:00, ID:838964
通常的位图都是包括R、G、B三个通道;但在某些位图里,还附有一个Alpha通道。那么这个通道是用来做什么的呢?这个通道一般是保存位图颜色位数深度、透明度等等信息的,只要你修改这个通道的信息,就会改变整个位图的性质,比如实现透明、遮罩、轨迹、融合、渐层覆盖等效果.

来自:coolbaby, 时间:2002-1-7 21:03:00, ID:841332
卷起千堆雪tyn兄 :
colortorgb以后,是不是 不是所有的图都有alpha通道的信息?


来自:卷起千堆雪tyn, 时间:2002-1-7 21:06:00, ID:841343
colortorgb仅仅是将TColor转变为LongInt,没有包含什么Alpha通道的信息;
Alpha通道是自己余外定义的。

可以看看TColor的定义。
siyu2002 2003-01-23
  • 打赏
  • 举报
回复
学习
mengxianbao1521 2003-01-23
  • 打赏
  • 举报
回复
算我一个
citytramper 2003-01-23
  • 打赏
  • 举报
回复
学习
bluemeteor 2003-01-23
  • 打赏
  • 举报
回复
图形的拖动


--------------------------------------------------------------------------------


试试看,带双缓冲的。放大和缩小就用StretchDraw就可以了。
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
BufBMP,FormBuf : TBitmap;
Position,FirstPt : TPoint;
Down : Boolean;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
BufBMP := TBitmap.Create;
FormBuf := TBitmap.Create;
FormBuf.Width := Width;
FormBuf.Height := Height;
BufBMP.LoadFromFile('c:\1.bmp');
Position := Point(0,0);
Down := FALSE;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
BufBMP.Free;
FormBuf.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Draw(Position.X,Position.Y,BufBMP);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Down := TRUE;
FirstPt := Point(X,Y);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Position := Point(Position.X + X - FirstPt.X,Position.Y + Y - FirstPt.Y);
Down := FALSE;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Down then begin
FormBuf.Canvas.Pen.color := clBtnFace;
FormBuf.Canvas.Brush.color := clBtnFace;
FormBuf.Canvas.Rectangle(0,0,Width,Height);
FormBuf.Canvas.Draw(Position.X + X - FirstPt.X,Position.Y + Y - FirstPt.Y,BufBMP);
Canvas.Draw(0,0,FormBuf);
end;
end;

end.

***********
type
TForm1 = class(TForm)
...
private
Jpg: TJpegImage;
StartX, StartY, px, py, mx, my: Integer;
MouseDown: Boolean;
procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
...
end;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
Jpg := TJpegImage.Create;
Jpg.LoadFromFile(FileName);
px := 0;
py := 0;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Jpg.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Draw(px, py, Jpg);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
if Assigned(Jpg) then begin
mx := ClientWidth - Jpg.Width;
my := ClientHeight - Jpg.Height;
end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not MouseDown then begin
MouseDown := True;
StartX := X;
StartY := Y;
end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if MouseDown then begin
Dec(px, StartX - X);
Dec(py, StartY - Y);
if px > 0 then px := 0;
if px < mx then px := mx;
if py > 0 then py := 0;
if py < my then py := my;
StartX := X;
StartY := Y;
Refresh;
end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if MouseDown then MouseDown := False;
end;

procedure TForm1.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
Msg.Result := -1;
end;
Billy_Chen28 2003-01-23
  • 打赏
  • 举报
回复


新年送大礼,好运伴着你!
我灌水,所以我快乐!
祝好人一生平安!
bluemeteor 2003-01-23
  • 打赏
  • 举报
回复
图像透明算法


--------------------------------------------------------------------------------


如何通过算法设置出象photoshop里一幅图象在另一幅图象上如何透明地显示,
并且可以设置透明度,如50%的透明度。并不是单幅图象的透明性。

BCB(:)) (2001-1-1 15:15:00) 得0分
Tbitmap有关的属性:
1.TansparentColor: 透明色;
2.PixelFormat:指明每一象点颜色所占的二进位数;
pf16bit: 点2字节;
pf24bit: 3字节;
pf32bit: 4字节;
3.ScanLine[行号];每一行象素缓冲的首址,即数组
的首址,每一象点占连续字节;

有了上面的3个属性,就可以写出合成2幅图象的算法;

算法:
for 第0行 到 最后一行
for 第0列 TO 最后一列
begin
1.取第一幅一个象点c1;
2.取第二幅一个象点c2;
3.如果c1是透明色,c3:=c2;
如果c2是透明色,c3:=c1;
4.送c3
end

nononono(null,null) (2001-1-1 20:01:00) 得0分
我有个效率不高(速度很慢),但效果绝对好的算法:


for 第0行 到 最后一行
for 第0列 TO 最后一列
begin
1.取第一幅一个像点c1的R色 c1R;
2.取第二幅一个像点c2的R色 c2R;
3.新像点的R色 cR := (c1R*K+c2R*(1-K));

4.取第一幅一个像点c1的G色 c1G;
5.取第二幅一个像点c2的G色 c2G;
6.新像点的G色 cG := (c1G*K+c2G*(1-K));

7.取第一幅一个像点c1的B色 c1B;
8.取第二幅一个像点c2的B色 c2B;
9.新像点的B色 cB := (c1B*K+c2B*(1-K));

10.新像点的RGB色 cRGB := RGB(cR,cG,cB);

end


其中 K 是2个图合并时,第一幅图的权重。改变这个 K 值可以得到一个渐变的效果。
jz_x(北风) (2001-1-2 15:04:00) 得0分
可将下面代码转换为DELPHI代码就可:

CDC memDC;
CBitmap &cBitmap=m_bmpDraw;
CBitmap* pOldMemBmp = NULL;
COLORREF col,colMask;
CRect cRect;
int x, y;
CRgn wndRgn, rgnTemp;

GetWindowRect(&cRect);
CPoint ptOrg=cRect.TopLeft();

BITMAP bmInfo;
cBitmap.GetObject(sizeof(bmInfo),&bmInfo);
CRect rcNewWnd=CRect(ptOrg,CSize(bmInfo.bmWidth,bmInfo.bmHeight));

memDC.CreateCompatibleDC(pDC);
pOldMemBmp = memDC.SelectObject(&cBitmap);
colMask=memDC.GetPixel(0,0);

wndRgn.CreateRectRgn(0, 0, rcNewWnd.Width(), rcNewWnd.Height());
for(x=0; x<=rcNewWnd.Width(); x++)
{
for(y=0; y<=rcNewWnd.Height(); y++)
{
col = memDC.GetPixel(x, y);
if(col == colMask)
{
rgnTemp.CreateRectRgn(x, y, x+1, y+1);
wndRgn.CombineRgn(&wndRgn, &rgnTemp, RGN_XOR);
rgnTemp.DeleteObject();
}
}
}
if (pOldMemBmp) memDC.SelectObject(pOldMemBmp);
SetWindowRgn((HRGN)wndRgn, TRUE);
MoveWindow(rcNewWnd);
lingweitao(涛生) (2001-1-2 16:48:00) 得0分
呵呵!看来这些人没明白你的意思呀!我曾经研究过这个问题,不过我是用VC做的,不知道用DELPHI怎么做,不过我可以把算法告诉你:取得两幅为图在每一点的像素值,分离出R,G,B的值,生成位图相应像素的R,G,B由下面公式决定:R=kR1+(1-k)R2 G=kG1+(1-k)G2 B=kB1+(1-k)B2 k为透明度,范围是0%-100% ,R1,R2,G1,G2,B1,B2为混合的两幅位图分离出来的R,G,B值,R,G,B为混合后的相应像素的R,G,B值。
APIer(APIer) (2001-1-2 17:01:00) 得0分
使用DDraw吧,这是一个简单的Alpha特效啊。
nononono的方法是可行的,但是使用了太多的乘法,还要用到浮点,在16位位图游戏编程中,大家通常使用这样的方法来进行Alpha混合:
1先分色并移位
2进行混色:(混色深度为32,足够了)
DestColor= (RscColor-DestColor)*Alpha_Depth〉〉5+DestColor;(R.G.B分别计算)
3最后合色
欢迎到我的业余游戏制作主页看看,上面有相关的文章:http://calfsoft.51.net
我的Email:APIer@cmmail.com
nononono(null,null) (2001-1-7 12:39:00) 得0分
akuan,这样试试:

分离RGB3色用"位与"、"移位"运算的方法;

透明的比例按 32、16分级。
如:如果是按32级,

A图的权重 K = n/32,则B图的权重 = (32-n)/32,
可以得到这样的算法:

cR := (c1R*n+c2R*(32-n));
再对cR右移4位。

这样的算法要快很多。
Billy_Chen28 2003-01-23
  • 打赏
  • 举报
回复
创建位图


One way to create a bitmap from a pixel array is to use the
Windows API function CreateDiBitmap(). This will allow you to
use one of many device independent bitmap formats that Windows
uses to store your pixel data. This has the advantage that it
will work on any Windows system, without knowing the pixel
format that the device uses ahead of time. Properly executed by
optimizing your code, theCreateDiBitmap function can be quite
fast as well. The following example creates a 256 color bitmap
from a pixel array. The bitmap fades from white to black using
256 gray shades. Note that normally, Windows reserves the first
and last ten colors for use as system colors, so you may only
get a maximum of 236 gray shades.

{$IFNDEF WIN32}
type
{Used for pointer math under Win16}
PPtrRec = ^TPtrRec;
TPtrRec = record
Lo: Word;
Hi: Word;
end;
{$ENDIF}

{Used for huge pointer math}

function GetBigPointer(lp: pointer;
Offset: Longint): Pointer;
begin
{$IFDEF WIN32}
GetBigPointer := @PByteArray(lp)^[Offset];
{$ELSE}
Offset := Offset + TPtrRec(lp).Lo;
GetBigPointer := Ptr(TPtrRec(lp).Hi + TPtrRec(Offset).Hi *
SelectorInc,
TPtrRec(Offset).Lo);
{$ENDIF}
end;

procedure TForm1.Button1Click(Sender: TObject);
var
hPixelBuffer : THandle; {Handle to the pixel buffer}
lpPixelBuffer : pointer; {pointer to the pixel buffer}
lpPalBuffer : PLogPalette; {The palette buffer}
lpBitmapInfo : PBitmapInfo; {The bitmap info header}
BitmapInfoSize : longint; {Size of the bitmap info header}
BitmapSize : longint; {Size of the pixel array}
PaletteSize : integer; {Size of the palette buffer}
i : longint; {loop variable}
j : longint; {loop variable}
OldPal : hPalette; {temp palette}
hPal : hPalette; {handle to our palette}
hBm : hBitmap; {handle to our bitmap}
Bm : TBitmap; {temporary TBitmap}
Dc : hdc; {used to convert the DOB to a DDB}
IsPaletteDevice : bool;
begin
Application.ProcessMessages;
{If range checking is on - turn it off for now}
{we will remember if range checking was on by defining}
{a define called CKRANGE if range checking is on.}
{We do this to access array members past the arrays}
{defined index range without causing a range check}
{error at runtime. To satisfy the compiler, we must}
{also access the indexes with a variable. ie: if we}
{have an array defined as a: array[0..0] of byte,}
{and an integer i, we can now access a[3] by setting}
{i := 3; and then accessing a[i] without error}
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}

{Lets check to see if this is a palette device - if so, then}
{we must do palette handling for a successful operation.}
{Get the screen's dc to use since memory dc's are not reliable}
dc := GetDc(0);
IsPaletteDevice :=
GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE;
{Give back the screen dc}
dc := ReleaseDc(0, dc);

{The bitmap info size must be the size of the BitmapInfo}
{plus the size of the color table - one color table entry}
{is already defined in TBitmapInfo}
BitmapInfoSize := sizeof(TBitmapInfo) + (sizeof(TRGBQUAD) * 255);

{The bitmap size must be the width of the bitmap rounded}
{up to the nearest 32 bit boundary}
BitmapSize := (sizeof(byte) * 256) * 256;

{The size of the palette must be the size of a TLogPalette}
{plus the number of color palette entries - 1, since there}
{is already one palette entry defined in TLogPalette}
if IsPaletteDevice then
PaletteSize := sizeof(TLogPalette) + (sizeof(TPaletteEntry) * 255);

{Get the memory for the BitmapInfo, the PixelBuffer, and the Palette}
GetMem(lpBitmapInfo, BitmapInfoSize);
hPixelBuffer := GlobalAlloc(GHND, BitmapSize);
lpPixelBuffer := GlobalLock(hPixelBuffer);

if IsPaletteDevice then
GetMem(lpPalBuffer, PaletteSize);

{Zero out the BitmapInfo, the PixelBuffer, and the Palette}
FillChar(lpBitmapInfo^, BitmapInfoSize, #0);
FillChar(lpPixelBuffer^, BitmapSize, #0);
if IsPaletteDevice then
FillChar(lpPalBuffer^, PaletteSize, #0);

{Fill in the BitmapInfo structure}
lpBitmapInfo^.bmiHeader.biSize := sizeof(TBitmapInfoHeader);
lpBitmapInfo^.bmiHeader.biWidth := 256;
lpBitmapInfo^.bmiHeader.biHeight := 256;
lpBitmapInfo^.bmiHeader.biPlanes := 1;
lpBitmapInfo^.bmiHeader.biBitCount := 8;
lpBitmapInfo^.bmiHeader.biCompression := BI_RGB;
lpBitmapInfo^.bmiHeader.biSizeImage := BitmapSize;
lpBitmapInfo^.bmiHeader.biXPelsPerMeter := 0;
lpBitmapInfo^.bmiHeader.biYPelsPerMeter := 0;
lpBitmapInfo^.bmiHeader.biClrUsed := 256;
lpBitmapInfo^.bmiHeader.biClrImportant := 256;

{Fill in the BitmapInfo color table with gray shades: black to white}
for i := 0 to 255 do
begin
lpBitmapInfo^.bmiColors[i].rgbRed := i;
lpBitmapInfo^.bmiColors[i].rgbGreen := i;
lpBitmapInfo^.bmiColors[i].rgbBlue := i;
end;

{Fill in the pixel buffer array with shades: black to white}
{In a 256 color bitmap the color is an index into the color table}
for i := 0 to 255 do
for j := 0 to 255 do
Byte(GetBigPointer(lpPixelBuffer, i + (j * 256))^) := j;

{Fill in the palette structure}
if IsPaletteDevice then
begin
lpPalBuffer^.palVersion := $300;
lpPalBuffer^.palNumEntries := 256;
{Fill in the palette structure color table}
for i := 0 to 255 do
begin
lpPalBuffer^.PalPalEntry[i].peRed := i;
lpPalBuffer^.PalPalEntry[i].peGreen := i;
lpPalBuffer^.PalPalEntry[i].peBlue := i;
end;

{Create a palette}
hPal := CreatePalette(lpPalBuffer^);
end;

{Get the screen's dc to use for the conversion since}
{memory dc's are not reliable to use for conversions}
dc := GetDc(0);

if IsPaletteDevice then
begin
{If we are using a palette, it must be}
{selected into the dc during the conversion}
OldPal := SelectPalette(dc, hPal, TRUE);
{Realize the palette}
RealizePalette(dc);
end;

{Do the conversion}
hBm := CreateDiBitmap(dc,
lpBitmapInfo^.bmiHeader,
CBM_INIT,
pChar(lpPixelBuffer),
lpBitmapInfo^,
DIB_RGB_COLORS);

if IsPaletteDevice then
begin
{Select the old palette back in}
SelectPalette(dc, OldPal, TRUE);
{Realize the old palette}
RealizePalette(dc);
end;

{Give back the screen dc}
dc := ReleaseDc(0, dc);

{Create a temporory TBitmap}
bm := TBitmap.Create;

{Free up the memory we used}
if IsPaletteDevice then
FreeMem(lpPalBuffer, PaletteSize);
GlobalUnlock(hPixelBuffer);
GlobalFree(hPixelBuffer);
FreeMem(lpBitmapInfo, BitmapInfoSize);

{Assign the palette}
if IsPaletteDevice then
bm.Palette := hPal;

{Assign the handle}
bm.Handle := hBm;

{Size Image1}
Image1.Width := 256;
Image1.Height := 256;

{Assign the bitmap}
Image1.Picture.Bitmap := bm;

SelectPalette(Image1.Picture.Bitmap.Canvas.Handle,
Image1.Picture.Bitmap.Palette,
false);

{Turn range checking back on if it was on when we started}
{$IFDEF CKRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}
end;
iwillgo2 2003-01-23
  • 打赏
  • 举报
回复
收藏
yczyk 2003-01-23
  • 打赏
  • 举报
回复
哇噻,楼主真是大财主,可惜我对图形处理不太熟悉。只有眼睁睁看人家拿分了!
Billy_Chen28 2003-01-23
  • 打赏
  • 举报
回复
图形显示的各种技巧:

概述
----目前在许多学习软件、游戏光盘中,经常会看到各种图形显示技巧,凭着图形的移动、交错、雨滴状、百页窗、积木堆叠等显现方式,使画面变得更为生动活泼,更能吸引观众。本文将探讨如何在Delphi中实现各种图形显示技巧。
基本原理
----在Delphi中,实现一副图象的显示是非常简单的,只要在Form中定义一个TImage组件,设置其picture属性,然后选择任何有效的.ICO、.BMP、.EMF或.WMF文件,进行Load,所选文
件就显示在TImage组件中了。但这只是直接将图形显示在窗体中,毫无技巧可言。为了使图形显示具有别具一格的效果,可以按下列步骤实现:
----5、定义一个TImage组件,把要显示的图形先装入到TImage组件中,也就是说,把图形内容从磁盘载入内存中,做为图形缓存。
----6、创建一新的位图对象,其尺寸跟TImage组件中的图形一样。
----7、利用画布(Canvas)的CopyRect功能(将一个画布的矩形区域拷贝到另一个画布的矩形区域),使用技巧,动态形成位图文件内容,然后在窗体中显示位图。
----实现方法
----下面介绍各种图形显示技巧:
----1.推拉效果
----将要显示的图形由上、下、左、右方向拉进屏幕内显示,同时将屏幕上原来的旧图盖掉,此种效果可分为四种,上拉、下拉、左拉、右拉,但原理都差不多,以上拉效果为例。
----原理:首先将放在暂存图形的第一条水平线,搬移至要显示的位图的最后一条,接着再将暂存图形的前两条水平线,依序搬移至要显示位图的最后两条水平线,然后搬移前三条、前四条叄?直到全部图形数据搬完为止。在搬移的过程中即可看到显示的位图由下而上浮起,而
达到上拉的效果。
----程序算法:
procedure TForm1.Button1Click(Sender: TObject);
var
newbmp: TBitmap;
i,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
for i:=0 to bmpheight do
begin
newbmp.Canvas.CopyRect(Rect
(0,bmpheight-i,bmpwidth,bmpheight),
image1.Canvas,
Rect(0,0,bmpwidth,i));
form1.Canvas.Draw(120,100,newbmp);
end;
newbmp.free;
newbmp.free;
end;
----2.垂直交错效果
----原理:将要显示的图形拆成两部分,奇数条扫描线由上往下搬移,偶数条扫描线的部分则由下往上搬移,而且两者同时进行。从屏幕上便可看到分别由上下两端出现的较淡图形向屏幕中央移动,直到完全清楚为止。
----程序算法:
procedure TForm1.Button4Click(Sender: TObject);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
i:=0;
while i< =bmpheight do
begin
j:=i;
while j >0 do
begin
newbmp.Canvas.CopyRect(Rect(0,j-1,bmpwidth,j),
image1.Canvas,
Rect(0,bmpheight-i+j-1,bmpwidth,bmpheight-i+j));
newbmp.Canvas.CopyRect(Rect
(0,bmpheight-j,bmpwidth,bmpheight-j+1),
image1.Canvas,
Rect(0,i-j,bmpwidth,i-j+1));
j:=j-2;
end;
form1.Canvas.Draw(120,100,newbmp);
i:=i+2;
end;
newbmp.free;
end;
----3.水平交错效果
----原理:同垂直交错效果原理一样,只是将分成两组后的图形分别由左右两端移进屏幕。
----程序算法:
procedure TForm1.Button5Click(Sender: TObject);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
i:=0;
while i< =bmpwidth do
begin
j:=i;
while j >0 do
begin
newbmp.Canvas.CopyRect(Rect(j-1,0,j,bmpheight),
image1.Canvas,
image1.Canvas,
Rect(bmpwidth-i+j-1,0,bmpwidth-i+j,bmpheight));
newbmp.Canvas.CopyRect(Rect
(bmpwidth-j,0,bmpwidth-j+1,bmpheight),
image1.Canvas,
Rect(i-j,0,i-j+1,bmpheight));
j:=j-2;
end;
form1.Canvas.Draw(120,100,newbmp);
i:=i+2;
end;
newbmp.free;
end;
----4.雨滴效果----原理:将暂存图形的最后一条扫描线,依序搬移到可视位图的第一条到最后一条扫描线,让此条扫描线在屏幕上留下它的轨迹。接着再把暂存图形的倒数第二条扫描线,依序搬移到可视位图的第一条到倒数第二条扫描线。其余的扫描线依此类推。----程序算法:
procedure TForm1.Button3Click(Sender: TObject);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
for i:=bmpheight downto 1 do
for j:=1 to i do
begin
newbmp.Canvas.CopyRect(Rect(0,j-1,bmpwidth,j),
image1.Canvas,
Rect(0,i-1,bmpwidth,i));
form1.Canvas.Draw(120,100,newbmp);
end;
newbmp.free;
end;
----5.百叶窗效果----原理:将放在暂存图形的数据分成若干组,然后依次从第一组到最后一组搬移,第一次每组各搬移第一条扫描线到可视位图的相应位置,第二次搬移第二条扫描线,接着搬移第三条、第四条扫描线.----程序算法:
procedure TForm1.Button6Click(Sender: TObject);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
xgroup,xcount:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
xgroup:=16;
xcount:=bmpheight div xgroup;
for i:=0 to xcount do
for j:=0 to xgroup do
begin
newbmp.Canvas.CopyRect(Rect
(0,xcount*j+i-1,bmpwidth,xcount*j+i),
image1.Canvas,
Rect(0,xcount*j+i-1,bmpwidth,xcount*j+i));
form1.Canvas.Draw(120,100,newbmp);
end;
newbmp.Free;
end;
----6.积木效果----原理:是雨滴效果的一种变化,不同之处在于,积木效果每次搬移的是一块图形,而不只是一根扫描线。----程序算法:
procedure TForm1.Button7Click(Sender: TObject);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
i:=bmpheight;
while i>0 do
begin
for j:=10 to i do
begin
newbmp.Canvas.CopyRect(Rect(0,j-10,bmpwidth,j),
image1.Canvas,
Rect(0,i-10,bmpwidth,i));
form1.Canvas.Draw(120,100,newbmp);
end;
i:=i-10;
end;
newbmp.free;
end;
结 束 语
---- 上 述 图 形 显 示 效 果 均 已 上 机 通 过, 软 件 环 境Delphi 3.0
, 硬 件 环 境Pentium 100M 兼 容 机。 使 用 效 果 很 好。
一、界面色彩渐变效果的实现
  界面色彩渐变效果是通过用渐变的画刷刷绘依次相邻的矩形块实现的。下面
列举实例说明:
  1.新建一个表单,假设其Width为500,设置一个按钮Button1,按此按钮将把表
单置为由左向右由黄变白的渐变效果。
  2.Button1按钮的代码如下:
  procedure TForm1.Button1Click(Sender: TObject);
  var i,j:Integer;
  Dct:TRect;
  begin
  j:=Form1.height;
  //获得表单高度
  for i:=0 to 255 do
  //此处设置RGB()中一个颜色值
  begin
  Canvas.Brush.Color:=RGB(255,255,i);
  //每次画矩形的画刷颜色
  Dct:=Rect(i*2,0,(i+1)*2,j);
  //每次刷绘的矩形区域
  Canvas.FillRect(Dct);
  //填充颜色
  end;
  end;
  二、图形整体拉出效果
  单纯的图形整体拉出效果比较简单,动态地改变图形区域的大小就可以实现,
但事先应将图形的“Stretch”设置为“True”。
  举例说明下拉效果:
  1.在表单上放置一图片,高度为200,属性“Height”设为0,“Stretch”设置
为True。添加“Timer”构件, “Interval”设为200,“Enable”设为Ture。
  2.在Timer1Timer中添加代码:
  procedure TForm1.Timer1Timer(Sender: TObject);
  begin
  Image1.Height:=Image1.Height+20;
  //设置增量
  if image1.Height=200 then Timer1.Enabled:=FALSE;
  //图形整体拉出完毕
  end;
  以上两例在Windows95,Delphi3.0环境下运行通过。
太阳冰转载《电脑报》1999年02月1日第05期
*********************
// 旋转显示
procedure TForm1.Button1Click(Sender: TObject);
begin form1.repaint;
for j:=0 to bitmap.height do
for i:=0 to bitmap.width do
begin
with rect1 do
begin
left:=i;
top:=j;
right:=i+1;
bottom:=j+1;
end;
with rect3 do
begin
left:=j;
top:=i;
right:=j+1;
bottom:=i+1;
end;
canvas.copyrect(rect3,bitmap.canvas,rect1);
end;
end;
//抽点逐渐显示
procedure TForm1.Button2Click(Sender: TObject);
begin
form1.repaint;
for n:=0 to 1 do
for m:=0 to 1 do
for j:=0 to bitmap.height div 2 do
for i:=0 to bitmap.width div 2 do
begin
with rect1 do begin
left:=2*i+m;
top:=2*j+n;
right:=2*i+1+m;
bottom:=2*j+1+n;
end; with rect3 do
begin
left:=2*i+m;
top:=2*j+n;
right:=2*i+1+m;
bottom:=2*j+1+n;
end;
canvas.copyrect(rect3,bitmap.canvas,rect1);
end;
end;
//缩小四分之一
procedure TForm1.Button3Click(Sender: TObject);
begin
form1.repaint;
for j:=0 to bitmap.height div 2 do
for i:=0 to bitmap.width div 2 do
begin
with rect1 do
begin
left:=2*i;
top:=2*j;
rig
xyue 2003-01-23
  • 打赏
  • 举报
回复
上面回答的太好乐

收藏一下
forgot 2003-01-23
  • 打赏
  • 举报
回复
http://www.delphiarea.com/products/#TPicShow_TDBPicShow
自己看源码。
加载更多回复(54)

5,388

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

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