⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 delphi 最好的3D控件GLScene_Demos
💻 PAS
字号:
{: Demo for color modulation and fade-in/out for bitmap fonts.<p>

   The bitmap Font used in this demo is obtained from<p>

   http://www.algonet.se/~guld1/freefont.htm<p>

   and was modified by me to have a red background so that I can have the
   character itself in black.<p>

   Nelson Chu
   cpegnel@ust.hk
}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, GLWin32Viewer, GLMisc, GLScene, GLObjects, GLHUDObjects,
  GLBitmapFont, GLCadencer, GLTimeEventsMgr, GLTeapot;

type
  TForm1 = class(TForm)
    GLScene1: TGLScene;
    GLSceneViewer1: TGLSceneViewer;
    BitmapFont: TGLBitmapFont;
    GLCamera1: TGLCamera;
    HUDText1: TGLHUDText;
    GLLightSource1: TGLLightSource;
    Teapot1: TGLTeapot;
    GLTimeEventsMGR1: TGLTimeEventsMGR;
    GLCadencer1: TGLCadencer;
    HUDText2: TGLHUDText;
    HUDText3: TGLHUDText;
    HUDText4: TGLHUDText;
    procedure GLTimeEventsMGR1Events0Event(event: TTimeEvent);
    procedure GLTimeEventsMGR1Events1Event(event: TTimeEvent);
    procedure GLTimeEventsMGR1Events2Event(event: TTimeEvent);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

const FadeOutMax = 100;
      FadeInMax  = 100;
      OverallTrans = 0.7;
implementation

{$R *.dfm}

uses VectorGeometry, VectorTypes;

var
  FadeOutCount : integer;
  FadeInCount : integer;
  OriginalColor : TVector4f;

procedure TForm1.FormCreate(Sender: TObject);
begin
   BitmapFont.Glyphs.LoadFromFile('..\..\media\toonfont.bmp');
end;

procedure TForm1.GLTimeEventsMGR1Events0Event(event: TTimeEvent);
begin
   if FadeOutCount < 0 then exit;

   HUDText1.ModulateColor.Color:=VectorMake(1, 1, 1, (FadeOutCount/FadeOutMax)*OverallTrans);
   dec(FadeOutCount);
end;

procedure TForm1.GLTimeEventsMGR1Events1Event(event: TTimeEvent);
begin
   FadeOutCount:=FadeOutMax;
   FadeInCount:=0;

   OriginalColor:=HUDText2.ModulateColor.Color;

   HUDText1.ModulateColor.Color:=VectorMake(1, 1, 1, (FadeOutCount/FadeOutMax)*OverallTrans);
   HUDText2.ModulateColor.Color:=VectorMake(1, 1, 1, 0);
end;

procedure TForm1.GLTimeEventsMGR1Events2Event(event: TTimeEvent);
var
   NewColor : TVector4f;
begin
   if FadeInCount >= FadeInMax then exit;

   NewColor:=VectorScale(OriginalColor, FadeInCount/FadeInMax);

   HUDText2.ModulateColor.Color:=NewColor;
   Inc(FadeInCount);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -