delphi&opengl载入一张图片bmp(表盘),实现背景透明并实现不停旋转,需源代码或提供方法!50分!急求! ( 积分: 50 )

  • 主题发起人 主题发起人 七七
  • 开始时间 开始时间

七七

Unregistered / Unconfirmed
GUEST, unregistred user!
delphi&opengl载入一张图片bmp(如表盘),实现背景透明并实现不停旋转,需源代码或提供方法!50分!急求!
 
delphi&opengl载入一张图片bmp(如表盘),实现背景透明并实现不停旋转,需源代码或提供方法!50分!急求!
 
用delphi实现这个功能可以吗?
QQ:51908496
 
不可一,我试过了,必须借助opengl的双缓存
 
找到了,delphix控件中有个例子可以实现./DelphiX2000_for_Delphi7/DelphiX2000/Samples/Graphic/AlphaBlending在这个目录下.
 
我不知道怎么跟你留言.
 
unit Main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DXClass, ExtCtrls, DXDraws, StdCtrls;

type
TMainForm = class(TDXForm)
DXDraw: TDXDraw;
DXTimer: TDXTimer;
ImageList: TDXImageList;
procedure DXDrawInitialize(Sender: TObject);
procedure DXDrawFinalize(Sender: TObject);
procedure DXTimerTimer(Sender: TObject;
LagCount: Integer);
procedure FormKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
procedure FormCreate(Sender: TObject);
private
FAngle: Integer;
end;


var
MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.DXDrawInitialize(Sender: TObject);
begin

DXTimer.Enabled := True;
end;


procedure TMainForm.DXDrawFinalize(Sender: TObject);
begin

DXTimer.Enabled := False;
end;


procedure TMainForm.DXTimerTimer(Sender: TObject;
LagCount: Integer);
begin

if not DXDraw.CanDraw then
Exit;

DXDraw.Surface.Fill(0);

ImageList.Items[0].DrawWaveX(DXDraw.Surface, 50, 30, 320, 90, 0, 2, 80, FAngle*4);

ImageList.Items[0].DrawAdd(DXDraw.Surface, Bounds(80, 20, 128, 32),
0, Trunc(Cos256(FAngle)*126+127));

ImageList.Items[0].DrawAdd(DXDraw.Surface, Bounds(90, 30, 128, 32),
0, Trunc(Cos256(FAngle+128)*126+127));

ImageList.Items[0].DrawRotateAlpha(DXDraw.Surface, DXDraw.Surface.Width div 2,
DXDraw.Surface.Height div 2, 320, 90, 0, 0.5, 0.5, FAngle, Trunc(Cos256(FAngle)*126+127));

Inc(FAngle);

with DXDraw.Surface.Canvasdo

begin

Brush.Style := bsClear;
Font.Color := clWhite;
Font.Size := 12;
Textout(0, 0, 'FPS: '+inttostr(DXTimer.FrameRate));

Release;
{ Indispensability }
end;


DXDraw.Flip;
end;


procedure TMainForm.FormKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin

{ Application end }
if Key=VK_ESCAPE then

Close;

{ Screen mode change }
if (ssAlt in Shift) and (Key=VK_RETURN) then

begin

DXDraw.Finalize;

ifdo
FullScreen in DXDraw.Options then

begin

RestoreWindow;

DXDraw.Cursor := crDefault;
BorderStyle := bsSizeable;
DXDraw.Options := DXDraw.Options - [doFullScreen];
end else

begin

StoreWindow;

DXDraw.Cursor := crNone;
BorderStyle := bsNone;
DXDraw.Options := DXDraw.Options + [doFullScreen];
end;


DXDraw.Initialize;
end;

end;


procedure TMainForm.FormCreate(Sender: TObject);
begin

ImageList.Items.MakeColorTable;
DXDraw.ColorTable := ImageList.Items.ColorTable;
DXDraw.DefColorTable := ImageList.Items.ColorTable;
DXDraw.UpdatePalette;
end;


end.
 
控件下载地址:
http://www.delphibox.com/article.asp?articleid=1767
 
如何在Jpg图像上写上字的代码,希望对你有帮助!


hmm, here's a sample with help of Bitmap, you can chance the brush style of canvas to bsClear to make the text transparent


uses
Jpeg;


procedure TForm1.Button1Click(Sender: TObject);

var
Bmp : TBitmap;

Jpg : TJpegImage;

begin

try
Bmp := TBitmap.Create;

Jpg := TjpegImage.Create;

Jpg.LoadFromFile('c:/img.jpg');

Bmp.Assign(Jpg);

Bmp.Canvas.Brush.Style := bsClear;

Bmp.Canvas.Font.Color := clYellow;

Bmp.Canvas.TextOut(10,10,'Hello World');

Jpg.Assign(Bmp);

Jpg.SaveToFile('c:/img2.jpg');

finally
bmp.Free;

jpg.Free;

end;


end;
 
用GLScene啊,开源的
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部