//-------------------------------------------------------------------------
//控 件 包：平滑特效字體控件包
//單元名稱：演示程序主窗體單元  　　　　　　　
//單元作者：CnPack 開發組 周勁羽
//下載網址：http://www.cnvcl.org
//Eamil   ：zjy@cnvcl.org
//發布類型：免費單元　　　　　　　　　　　　　　　　　　
//備　　注：該單元演示了控件包的一些功能
//最后更新：2002.06.26
//-------------------------------------------------------------------------
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  AAFont, AACtrls, ComCtrls, MPlayer, StdCtrls, Buttons, ExtCtrls,
  AAFontDialog;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    bbtnRandomUpdate: TBitBtn;
    AAScrollText: TAAScrollText;
    AALabel1: TAALabel;
    AALabel2: TAALabel;
    AALabel3: TAALabel;
    AALabel4: TAALabel;
    AALabel5: TAALabel;
    AALabel6: TAALabel;
    AALabel8: TAALabel;
    AALabel9: TAALabel;
    AALabel7: TAALabel;
    tbSpeed: TTrackBar;
    AALinkLabel1: TAALinkLabel;
    AALinkLabel2: TAALinkLabel;
    AAFontDialog: TAAFontDialog;
    AALabel10: TAALabel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    AALinkLabel3: TAALinkLabel;
    AALinkLabel4: TAALinkLabel;
    AALinkLabel5: TAALinkLabel;
    AAText1: TAAText;
    AALinkLabel6: TAALinkLabel;
    AALinkLabel7: TAALinkLabel;
    AAFadeText1: TAAFadeText;
    Edit: TEdit;
    BitBtn1: TBitBtn;
    Label1: TLabel;
    AALabel11: TAALabel;
    AALabel12: TAALabel;
    AALabel13: TAALabel;
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure AAScrollTextLabels8GetText(Sender: TUserLabel;
      var Text: String);
    procedure bbtnRandomUpdateClick(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure tbSpeedChange(Sender: TObject);
    procedure AALabel1DblClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    MidName: string;
    MediaPlayer: TMediaPlayer;
    Ver: Integer;
    procedure OnNotify(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

const
  csResName = 'YYGW';
  csResNum = 3;
  csDesMidFile = 'yygw.mid';
  csTitleYygw = 'TitleYygw';
  csTextYygw = 'TextYygw';
  csTextVer = 'TextVer';
  csText2 = 'Text2';

{$R *.DFM}
{$R Mid.RES}

// 窗體顯示前
procedure TForm1.FormShow(Sender: TObject);
var
  TempPath: array[0..MAX_PATH] of Char;
begin
  MediaPlayer := TMediaPlayer.Create(Self); // 創建媒體播放器用于播放MIDI
  MediaPlayer.Parent := Self;
  MediaPlayer.Visible := False;
  MediaPlayer.OnNotify := OnNotify;
  GetTempPath(MAX_PATH, TempPath);
  MidName := TempPath + csDesMidFile;
  AAScrollText.Active := True;
end;

// 窗體釋放
procedure TForm1.FormDestroy(Sender: TObject);
begin
  MediaPlayer.Close;
  DeleteFile(MidName);
end;

// 雙擊標簽設置字體效果
procedure TForm1.AALabel1DblClick(Sender: TObject);
begin
  if Sender is TAALabel then
  begin
    AAFontDialog.Effect := TAALabel(Sender).Effect.FontEffect;
    AAFontDialog.Font := TAALabel(Sender).Font; // 允許直接用賦值符賦值
    if AAFontDialog.Execute then
    begin
      TAALabel(Sender).Effect.FontEffect := AAFontDialog.Effect;
      TAALabel(Sender).Font := AAFontDialog.Font;
    end;
  end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  AALinkLabel1.Click; // 使用TAALinkLabel.Click方法相當于用戶點擊控件
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  AALinkLabel2.Click;
end;

// 播放器通知
procedure TForm1.OnNotify(Sender: TObject);
begin
  if MediaPlayer.Mode = mpStopped then
    MediaPlayer.Play; // 循環播放
  MediaPlayer.Notify := True;
end;

// 切換頁面控制背景MIDI
procedure TForm1.PageControl1Change(Sender: TObject);
begin
  if PageControl1.ActivePage = TabSheet4 then
    bbtnRandomUpdateClick(nil)
  else
    MediaPlayer.Close;
end;

// 調節滾動速度
procedure TForm1.tbSpeedChange(Sender: TObject);
begin                      // 如果為0將停止滾動，故加1
  AAScrollText.ScrollDelay := 10 * tbSpeed.Position + 1;
end;

// 取標簽內容（演示用戶標簽的使用）
procedure TForm1.AAScrollTextLabels8GetText(Sender: TUserLabel;
  var Text: String);
const
  Vers: array[0..2] of string = ('激情版', '傷情版', '深情版');
begin
  Text := Vers[Ver];  // 運行時可更改滾動文本內容，該內容在控件Reset時讀取
end;

// 更新作者填詞的《與月共舞》并播放MIDI原曲《蝶戀》
procedure TForm1.bbtnRandomUpdateClick(Sender: TObject);
const
  csFontMax = 9;
  csFonts: array[0..csFontMax - 1] of string = ('隸', '楷', '魏', '黑', '美', '圓',
    '黃', '藝', '琥');
var
  i, j: Integer;
  Fonts: TStrings;
  FontName: string;
  ResStream: TResourceStream;
  ResName: string;
  function RandomColor: TColor;   //隨機色
  begin
    Result := HSLToRGB(Random, 0.75 + Random * 0.25, 0.3 + Random * 0.25);
  end;
begin
  MediaPlayer.Close;
  try
    Ver := Random(csResNum);
    ResName := csResName + IntToStr(Ver);
    ResStream := TResourceStream.Create(hInstance, PChar(ResName), RT_RCDATA);
    try
      ResStream.SaveToFile(MidName);
      MediaPlayer.FileName := MidName;
      MediaPlayer.Open;
      MediaPlayer.Play;
      MediaPlayer.Notify := True;
    finally
      ResStream.Free;
    end;
  except
    ;
  end;
  Fonts := TStringList.Create;
  try
    AAScrollText.BeginUpdate;  // 開始更新，禁止自動重繪
    try
      for i := 0 to Screen.Fonts.Count - 1 do  // 創建符合條件的字體列表
      begin
        FontName := Screen.Fonts[i];
        if Pos('@', FontName) <= 0 then  // 不是倒放字體
        begin
          for j := 0 to csFontMax - 1 do
            if Pos(csFonts[j], FontName) > 0 then
            begin
              Fonts.Add(FontName);
              Break;
            end;
        end;
      end;
      with AAScrollText.Fonts do   // 設置隨機字體
      begin
        if Fonts.Count > 0 then
        begin    // 使用IndexOf來取得字體標簽項
          Items[IndexOf(csTitleYygw)].Font.Name := Fonts[Random(Fonts.Count)];
          Items[IndexOf(csTextYygw)].Font.Name := Fonts[Random(Fonts.Count)];
          Items[IndexOf(csTextVer)].Font.Name := Fonts[Random(Fonts.Count)];
          Items[IndexOf(csText2)].Font.Name := Fonts[Random(Fonts.Count)];
        end;    // 設置隨機顏色和效果
        Items[IndexOf(csTitleYygw)].Effect.Gradual.StartColor := RandomColor;
        Items[IndexOf(csTitleYygw)].Effect.Gradual.EndColor := RandomColor;
        Items[IndexOf(csTextYygw)].Effect.Gradual.StartColor := RandomColor;
        Items[IndexOf(csTextYygw)].Effect.Gradual.EndColor := RandomColor;
        Items[IndexOf(csTitleYygw)].Effect.Outline := Odd(Random(100));
        Items[IndexOf(csTextVer)].Font.Color := RandomColor;
        Items[IndexOf(csText2)].Font.Color := RandomColor;
        Items[IndexOf(csTitleYygw)].Effect.Gradual.Style :=
          TGradualStyle(Random(Ord(High(TGradualStyle)) + 1));
        Items[IndexOf(csTextYygw)].Effect.Gradual.Style :=
          TGradualStyle(Random(Ord(High(TGradualStyle)) + 1));
      end;
    finally
      AAScrollText.EndUpdate;  // 結束更新
      AAScrollText.Reset;  // 重新繪制文本
    end;
  finally
    Fonts.Free;
  end;
end;

// 漸隱到指定行
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  AAFadeText1.FadeToStr(Edit.Text);
end;

end.