?? unit1.pas
字號:
//-------------------------------------------------------------------------
//控 件 包:平滑特效字體控件包
//單元名稱:演示程序主窗體單元
//單元作者:與月共舞工作室 周勁羽
//下載網址:http://www.yygw.net
//Eamil :yygw@yygw.net
//發布類型:免費單元
//備 注:該單元演示了控件包的一些功能
//最后更新: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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -