u_form1.pas

很好地delphi书籍源码

unit U_Form1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls, MPlayer, Menus, Buttons, ToolWin,
  FileCtrl,mmSystem,ShellApi;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    FileMenu: TMenuItem;
    DATMenu: TMenuItem;
    AVIMenu: TMenuItem;
    OpenDialog1: TOpenDialog;
    N4: TMenuItem;
    WAVMenu: TMenuItem;
    MP3Menu: TMenuItem;
    AllMenu: TMenuItem;
    CoolBar1: TCoolBar;
    PlaySB1: TSpeedButton;
    StopSB1: TSpeedButton;
    PlaySB2: TSpeedButton;
    StopSB2: TSpeedButton;
    KeepPlaySB: TSpeedButton;
    Timer1: TTimer;
    ListPanel: TPanel;
    ListCB: TComboBox;
    ListFileLabel: TLabel;
    ProgressLabel: TLabel;
    N5: TMenuItem;
    ExitMenu: TMenuItem;
    PBar1: TProgressBar;
    MediaPlayer1: TMediaPlayer;
    N1: TMenuItem;
    OpenMenu: TMenuItem;
    SpeedUpMenu: TMenuItem;
    SlowDownMenu: TMenuItem;
    EditMenu: TMenuItem;
    SongP: TPanel;
    procedure ChooiceFile(Sender: TObject);
    procedure CoolBarButton(Sender: TObject);
    procedure MediaPlayer1Notify(Sender: TObject);
    procedure AllMenuClick(Sender: TObject);
    procedure ListCBChange(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ExitMenuClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedUpMenuClick(Sender: TObject);
    procedure SlowDownMenuClick(Sender: TObject);
    procedure EditMenuClick(Sender: TObject);
    procedure OpenMenuClick(Sender: TObject);
  private
  public
    Dir:string;
    IsLast:boolean;
    procedure SpeedButton(T,C1,C2,C3,C4,C5:boolean);
    procedure ShowText(SongName:string);
    Procedure BmpCreate(LineHeight:word);

  end;

var
  Form1: TForm1;

  MovingStep:integer;
  Currline:integer;
  Item:TStringList;
  bmp:TBitMap;
  bRect,R1:TRect;
  iDc:HDC;
  CurrSongName:string;
implementation

uses U_Form2;

{$R *.dfm}
procedure TForm1.ChooiceFile(Sender: TObject);
var
  WhichMenu:byte;
begin
  WhichMenu:=0;
  if (MediaPlayer1.Mode=mpPlaying)or(MediaPlayer1.Mode=mpOpen) then
  begin  //如果正在播放或已经打开
    MediaPlayer1.Stop; //停止设备
    MediaPlayer1.DeviceType:=dtAutoSelect; //设置由播放的文件确定设备类型
  end;
  if Sender is TMenuItem then
  begin
    WhichMenu:=(Sender as TMenuItem).Tag;
    case WhichMenu of //根据所击菜单项确定过滤器扩展名
     1: OpenDialog1.Filter:=(Sender as TMenuItem).Caption+'|*.dat';
     2: OpenDialog1.Filter:=(Sender as TMenuItem).Caption+'|*.avi';
     3: OpenDialog1.Filter:=(Sender as TMenuItem).Caption+'|*.wav';
     4: OpenDialog1.Filter:=(Sender as TMenuItem).Caption+'|*.mp3';
     5: OpenDialog1.Filter:=(Sender as TMenuItem).Caption+'|*.*';
    end;
  end;
  if OpenDialog1.Execute then
  begin
    MediaPlayer1.FileName:=OpenDialog1.FileName;
    MediaPlayer1.Open;
    if (WhichMenu=1)or(WhichMenu=2) then  //视频文件
    begin
      MediaPlayer1.Display:=Form2;
      MediaPlayer1.DisplayRect:=Rect(0,0,Form2.ClientWidth,Form2.ClientHeight);
      Form2.Caption:='正在播放:'+MediaPlayer1.FileName;
      Form2.Show;
      Caption:='正在播放:'+MediaPlayer1.FileName;
      SpeedButton(True,false,true,false,false,false);
    end else if (WhichMenu=3)or(WhichMenu=4) then  //音频文件
      SpeedButton(false,false,false,true,false,false);
  end;
end;

procedure TForm1.CoolBarButton(Sender: TObject);
begin
  if Sender is TSpeedButton then
    case (Sender as TSpeedButton).Tag of
    1: begin
         Form2.Show;
         SpeedButton(true,false,true,false,false,false);
       end;
    2: begin
         Form2.Close;
         SpeedButton(false,true,false,false,false,false);
       end;
    3:begin
        MediaPlayer1.Play;
        SpeedButton(true,false,false,false,true,false);
      end;
    4:begin
        MediaPlayer1.Stop;
        SpeedButton(false,false,false,true,false,false);
      end;
    5:begin
        if (Sender as TSpeedButton).Down then
        begin
          MediaPlayer1.Play;
          SpeedButton(true,false,false,false,false,true);
          (Sender as TSpeedButton).Caption:='停止'
        end else
        begin
          MediaPlayer1.Stop;
          SpeedButton(false,false,false,false,false,true);
          (Sender as TSpeedButton).Caption:='播放';
        end;
      end;
    end;
   Caption:='正在播放:'+MediaPlayer1.FileName;
end;

procedure TForm1.AllMenuClick(Sender: TObject);
var
  sr:TSearchRec;
  Fileext:String ;
begin
  if SelectDirectory('选择目录:', '', Dir) then
  begin
    if FindFirst(Dir+'\*.*',0,sr)=0 then
    begin
      ListCB.Items.Clear;
      if sr.Attr<>faDirectory then
      begin
        Fileext:=LowerCase(ExtractFileExt(sr.Name));
        if(fileext='.wav')or(fileext='.mp3')or(fileext='.dat')or(fileext='.avi')then
          ListCB.Items.Add(sr.Name);
      end;
    end;
    while FindNext(sr)=0 do
    begin
      if (sr.Attr<>faDirectory)then
      begin
        Fileext:=LowerCase(ExtractFileExt(sr.Name));
        if(fileext='.wav')or(fileext='.mp3')or(fileext='.dat')or(fileext='.avi')then
           ListCB.Items.Add(sr.Name);
      end;
    end;
  end;
  if ListCB.Items.Count=0 then
    ShowMessage('你所选择的文件夹中没有有效的音频文件！');
end;

procedure TForm1.SpeedButton(T,C1, C2, C3, C4, C5: boolean);
begin
  Timer1.Enabled:=T;
  ListCB.Enabled:=not KeepPlaySB.Down;
  AllMenu.Enabled:=not KeepPlaySB.Down;
  PlaySB1.Enabled:=C1 ;
  StopSB1.Enabled:=C2 ;
  PlaySB2.Enabled:=C3 ;
  StopSB2.Enabled:=C4 ;
  KeepPlaySB.Enabled:=C5;
  EditMenu.Enabled:=C1 or C3 ;
end;

procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
  if IsLast=true then exit;
  with MediaPlayer1 do
  begin
    if (NotifyValue=nvFailure) then
      Application.Terminate;
    if((Mode=mpStopped)or(NotifyValue=nvSuccessful))and(KeepPlaySB.Down=true)then
    begin
      Stop;
      DeviceType:=dtAutoSelect;
      if ListCB.ItemIndex=ListCB.Items.Count-1 then
      begin
        IsLast:=true;
        exit;
      end else ListCB.ItemIndex:=ListCB.ItemIndex+1;
      FileName:=dir+'\'+ListCB.Items.Strings[ListCB.ItemIndex];
      Open;
      Play;
      Caption:='正在播放:'+MediaPlayer1.FileName;
      end;
  end;
end;

procedure TForm1.ListCBChange(Sender: TObject);
begin
  if ListCB.text='' then exit;
  if (MediaPlayer1.Mode=mpPlaying)or(MediaPlayer1.Mode=mpOpen) then
  begin
    MediaPlayer1.Stop;
    MediaPlayer1.DeviceType:=dtAutoSelect;
  end;
    if ListCB.ItemIndex=ListCB.Items.Count-1 then IsLast:=true
    else IsLast:=false;
    MediaPlayer1.FileName:=dir+'\'+ListCB.text;
    MediaPlayer1.Open;
    MediaPlayer1.Play;
    SpeedButton(true,false,false,false,false,true);
    KeepPlaySB.Down:=true;
    Caption:='正在播放:'+MediaPlayer1.FileName;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  N:byte;
begin
  N:=Round(100*MediaPlayer1.Position/(MediaPlayer1.Length+1));
  PBar1.Position:=N;
  ProgressLabel.Caption:=
    Format('列表中第%d个文件 ，播放进度 %d',[ListCB.ItemIndex+1,N])+' %';

  BitBlt(iDc,0,0,SongP.Width,SongP.Height,
  Bmp.Canvas.Handle,0,Currline,srcCopy);        //改变currline可实现左移右移
  Inc(Currline,MovingStep);
  if Currline>=bRect.Bottom-SongP.Height+400 then
  begin
    Timer1.Enabled:=False;
    Currline:=0;
  end;
end;

procedure TForm1.ExitMenuClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SpeedButton(false,false,false,false,false,false);
  KeepPlaySB.Down:=true;
  CurrSongName:='外婆的澎湖湾.txt';
  iDC:=GetDc(SongP.handle);
  Currline:=0;
  MovingStep:=5;
  ShowText(CurrSongName);

end;

procedure TForm1.BmpCreate(LineHeight: word);
var
  i,y:integer;
begin
  if bmp<>nil then bmp.free;
  bmp:=TBitMap.Create;
  with bRect do //Rect 矩形坐标(左上x,左下y,右上x,右下y)
  begin
    Top:=0;
    Left:=0;
    Right:=SongP.Width;
    Bottom:=LineHeight*Item.Count+Height;//行高*行数+form高度
  end;
  Bmp.Height:=bRect.Bottom;//图片高度
  Bmp.Width:=bRect.Right;
  Bmp.Canvas.Brush.Color:=clInfoBk;
  Bmp.Canvas.FillRect(bRect);
  Bmp.Canvas.Font.Color:=clRed;  //控制显示字体颜色
  Bmp.Canvas.Font.Size:=LineHeight div 2 ;  //控制显示字体颜色
  Bmp.Canvas.Brush.Style:=bsClear ;
  R1:=bRect;
  y:=SongP.Height-100;
  for i:=0 to Item.Count-1 do
  begin
    R1.Top:=y;
    R1.Bottom:=R1.Top+LineHeight;
    DrawText(Bmp.Canvas.Handle,pChar(Item[i]),-1,R1,Dt_Center or Dt_Top);//中对齐
  //DrawText(Bmp.Canvas.Handle,pChar(Item[i]),-1,R1,Dt_Left or Dt_Top); //左对齐
  //DrawText(Bmp.Canvas.Handle,pChar(Item[i]),-1,R1,Dt_Right or Dt_Top);//右对齐
    Inc(y,LineHeight);
  end;
end;

procedure TForm1.ShowText(SongName: string);
var
  ss:string;
  ReadFile:TextFile;
begin
  if SongName='' then exit;
  AssignFile(ReadFile,SongName);
  Reset(ReadFile);
  Item:=TStringList.Create;
    while not eof(ReadFile) do
    begin
      Readln(ReadFile,ss);
      Item.Add(ss);
    end;
  CloseFile(ReadFile);
  BmpCreate(30);
  Item.Free;//释放串
end;


procedure TForm1.SpeedUpMenuClick(Sender: TObject);
begin
  if MovingStep<SongP.ClientHeight then inc(MovingStep);
end;

procedure TForm1.SlowDownMenuClick(Sender: TObject);
begin
  if MovingStep>1 then dec(MovingStep);
end;

procedure TForm1.EditMenuClick(Sender: TObject);
begin
  if CurrSongName='' then
    ShellExecute(0,'Open','NotePad.exe',nil,nil,1)
  else
    ShellExecute(0,'Open',Pchar(CurrSongName),nil,nil,1)
end;

procedure TForm1.OpenMenuClick(Sender: TObject);
begin
  OpenDialog1.Filter:='文本文件(*.txt)|*.txt|所有文件(*.*)|*.*';
  if OpenDialog1.Execute then
  begin
    CurrSongName:=OpenDialog1.FileName;
    ShowText(OpenDialog1.FileName);
  end;
end;

end.