unitformenglishvoice.pas

输入生成标准英语音标,帮助你学习英语,也可以便利英语音标的打印.

unit UnitFormEnglishVoice;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ToolWin, ComCtrls, ExtCtrls, ImgList, StdCtrls, Clipbrd, Buttons;

type
  TSymbol = record
    Index: Integer;
    Left: Integer;
    Width: Integer;
  end;

  TFormEnglishVoice = class(TForm)
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    ToolButton18: TToolButton;
    ToolButton19: TToolButton;
    ToolButton20: TToolButton;
    ToolButton21: TToolButton;
    ToolButton22: TToolButton;
    ToolButton23: TToolButton;
    ToolButton24: TToolButton;
    ToolButton25: TToolButton;
    ToolButton26: TToolButton;
    ToolButton27: TToolButton;
    ToolButton28: TToolButton;
    ToolButton29: TToolButton;
    ToolButton30: TToolButton;
    Panel1: TPanel;
    Image1: TImage;
    ImageList1: TImageList;
    ToolButton33: TToolButton;
    ToolButton34: TToolButton;
    ToolButton35: TToolButton;
    ToolButton36: TToolButton;
    ToolButton37: TToolButton;
    ToolButton38: TToolButton;
    ToolButton39: TToolButton;
    ToolButton40: TToolButton;
    ToolButton41: TToolButton;
    ToolButton42: TToolButton;
    ToolButton43: TToolButton;
    ScrollBox1: TScrollBox;
    Panel2: TPanel;
    editVoiceText: TEdit;
    ToolButton31: TToolButton;
    BtnLeftMove: TSpeedButton;
    BtnRightMove: TSpeedButton;
    BtnDelSelected: TSpeedButton;
    BtnDelAll: TSpeedButton;
    Splitter1: TSplitter;
    BtnCopy: TSpeedButton;
    Panel3: TPanel;
    cbMostTop: TCheckBox;
    cbCopyToClipboard: TCheckBox;
    cbbImageSize: TComboBox;
    Label1: TLabel;
    cbNoBlankLine: TCheckBox;
    procedure editVoiceTextChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure BtnDelSelectedClick(Sender: TObject);
    procedure BtnDelAllClick(Sender: TObject);
    procedure BtnLeftMoveClick(Sender: TObject);
    procedure BtnRightMoveClick(Sender: TObject);
    procedure editVoiceTextKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BtnCopyClick(Sender: TObject);
    procedure cbMostTopClick(Sender: TObject);
    procedure cbbImageSizeChange(Sender: TObject);
    procedure cbCopyToClipboardClick(Sender: TObject);
    procedure cbNoBlankLineClick(Sender: TObject);
  private
    FSymbolIndex: Integer;
    procedure SetSymbolIndex(const Value: Integer);
    function GetSymbolSize: Integer;
  private
    { Private declarations }
    FSymbolBitmap: TBitmap;
    FImageInfo: TStringList;
    Symbols: array [0..43] of TSymbol;
    function SymbolCharacter: Char;
    procedure SymbolLoad(Size: Integer);
    procedure SymbolFree;
    procedure SymbolMove(Index: Integer);
    procedure SymbolOnClick(Sender: TObject);
    procedure SymbolDelete(Size: Integer; Auto: Boolean; Ahead: Boolean);
    procedure SymbolImage(Size: Integer; SBmp: TBitmap; Index: Integer);
    procedure DrawVoice(Size: Integer; SBmp: TBitmap);
    property SymbolSize: Integer read GetSymbolSize;
    property SymbolIndex: Integer read FSymbolIndex write SetSymbolIndex;
  public
    { Public declarations }
  end;


var
  FormEnglishVoice: TFormEnglishVoice;

implementation

{$R *.dfm}

function LoadResourceString(SourceID:Integer):String;
begin
  Result:=SysUtils.LoadStr(SourceID);
end;

function GetWidth(S: String): Integer;
var
  Index: Integer;
begin
  Result := -1;
  Index := Pos(';' ,S);
  if Index = -1 then Exit;
  Result := StrToIntDef(Copy(S, 1, Index - 1), 10);
end;

function GetIndex(S: String): Integer;
var
  Index: Integer;
begin
  Result := -1;
  Index := Pos(';' ,S);
  if Index = -1 then Exit;
  Result := StrToIntDef(Copy(S, Index + 1, Length(S) - Index), -1);
end;

procedure TFormEnglishVoice.SymbolFree;
var
  Index: integer;
  FImage: TImage;
begin
  Image1.Picture:=nil;
  Image1.Refresh;
  FImage:=TImage.Create(nil);
  try
    for Index := ScrollBox1.ComponentCount - 1  downto 0 do
    begin
      if ScrollBox1.Components[Index] is TImage then
      begin
        FImage := TImage(ScrollBox1.Components[Index]);
        FreeAndNil(FImage);
      end;
    end;
    FImageInfo.Clear;
    SymbolIndex := -1;
  finally
    FreeAndNil(FImage);
  end;
end;

procedure TFormEnglishVoice.FormCreate(Sender: TObject);
begin
  cbbImageSize.ItemIndex := 1;
  SymbolIndex := -1;
  FSymbolBitmap := TBitmap.Create;
  FImageInfo := TStringList.Create;
  SymbolLoad(SymbolSize);
end;

procedure TFormEnglishVoice.FormDestroy(Sender: TObject);
begin
  SymbolFree;
  FreeAndNil(FImageInfo);
  FreeAndNil(FSymbolBitmap);
end;

procedure TFormEnglishVoice.SymbolImage(Size: Integer; SBmp: TBitmap; Index: Integer);
var
  iDefault, iOffSet: Integer;
  FImage: TImage;
begin
  try
    iDefault := (Size + 2) * 2;
    iOffSet := (Size + 2) * 2 + 1;
    FImage := TImage.Create(ScrollBox1);
    FImage.Parent := ScrollBox1;
    FImage.Width := iDefault;
    FImage.Height := iDefault;
    FImage.Center := True;
    FImage.Stretch := False;
    FImage.Transparent := True;
    FImage.Left := (ScrollBox1.ComponentCount - 1) mod (ScrollBox1.Width div iOffSet) * iOffSet;
    FImage.Top  := (ScrollBox1.ComponentCount - 1) div (ScrollBox1.Width div iOffSet) * iOffSet;

    FImage.Tag := ScrollBox1.ComponentCount - 1;
    FImage.OnClick := SymbolOnClick;
    FImage.Picture.Bitmap.Width := iDefault;
    FImage.Picture.Bitmap.Height := iDefault;
    FImage.Picture.Bitmap.PixelFormat := FSymbolBitmap.PixelFormat;
    FImage.Picture.Bitmap.Canvas.CopyRect(Rect((iDefault - Symbols[Index].Width) div 2,
                                               (iDefault - FSymbolBitmap.Height) div 2,
                                               (iDefault - Symbols[Index].Width) div 2 + Symbols[Index].Width,
                                               (iDefault - FSymbolBitmap.Height) div 2 + FSymbolBitmap.Height),
                                          FSymbolBitmap.Canvas,
                                          Rect(Symbols[Index].Left,
                                               0,
                                               Symbols[Index].Left + Symbols[Index].Width,
                                               FSymbolBitmap.Height));
    FImageInfo.Add(IntToStr(Symbols[Index].Width) + ';' + IntToStr(Index));
    DrawVoice(Size, SBmp);
    BtnDelAll.Enabled := (ScrollBox1.ComponentCount <> 0);
    BtnCopy.Enabled   := (ScrollBox1.ComponentCount <> 0);
  except

  end;
end;

procedure TFormEnglishVoice.ToolButton1Click(Sender: TObject);
begin
  SymbolImage(SymbolSize, Image1.Picture.Bitmap, (Sender as TToolButton).Tag);
  editVoiceText.SetFocus;
end;

procedure TFormEnglishVoice.SymbolOnClick(Sender: TObject);
begin
  if Sender is TImage then
  begin
    if (FSymbolIndex <> - 1) then
    begin
      with (ScrollBox1.Components[FSymbolIndex] as TImage) do
      begin
        Canvas.Pen.Color := clWhite;
        Canvas.MoveTo(1, 1);
        Canvas.LineTo(Width - 1, 1);
        Canvas.LineTo(Width - 1, Height - 1);
        Canvas.LineTo(1, Height - 1);
        Canvas.LineTo(1, 1);
      end;
    end;

    with (Sender as TImage) do
    begin
      SymbolIndex := Tag;
      Canvas.Pen.Color := clRed;
      Canvas.MoveTo(1, 1);
      Canvas.LineTo(Width - 1,  1);
      Canvas.LineTo(Width - 1, Height - 1);
      Canvas.LineTo(1, Height - 1);
      Canvas.LineTo(1, 1);
    end;
    editVoiceText.Text := SymbolCharacter();
  end;
end;

procedure TFormEnglishVoice.DrawVoice(Size: Integer; SBmp: TBitmap);
var
  iDefault: Integer;
  Index, IWidth: integer;
begin
  if SBmp = nil then Exit;
  SBmp.Width := Symbols[42].Width;
  SBmp.Height := FSymbolBitmap.Height;
  SBmp.PixelFormat := FSymbolBitmap.PixelFormat;
  SBmp.Canvas.CopyRect(Rect(0, 0, SBmp.Width, SBmp.Height),
                       FSymbolBitmap.Canvas,
                       Rect(Symbols[42].Left, 0, Symbols[42].Left + Symbols[42].Width, SBmp.Height));
  iDefault := (Size + 2) * 2;
  for Index := 0 to ScrollBox1.ComponentCount - 1 do
  begin
    if ScrollBox1.Components[Index] is TImage then
    begin
      IWidth := GetWidth(FImageInfo[Index]);
      with (ScrollBox1.Components[Index]) as TImage do
      begin
        SBmp.Width := SBmp.Width + IWidth;
        if not cbNoBlankLine.Checked then
          SBmp.Width := SBmp.Width + (Size div 24 + 1);
        SBmp.Canvas.CopyRect(Rect(SBmp.Width - IWidth, 0, SBmp.Width, SBmp.Height),
                             Canvas,
                             Rect((iDefault - IWidth) div 2,
                                  (iDefault - SBmp.Height) div 2,
                                  (iDefault - IWidth) div 2 + IWidth,
                                  (iDefault - SBmp.Height) div 2 + SBmp.Height));
      end;
    end;
  end;

  SBmp.Width := SBmp.Width + Symbols[43].Width + 1;
  SBmp.Canvas.CopyRect(Rect(SBmp.Width - Symbols[43].Width, 0, SBmp.Width, SBmp.Height),
                       FSymbolBitmap.Canvas,
                       Rect(Symbols[43].Left, 0, Symbols[43].Left + Symbols[43].Width, SBmp.Height));
  if cbCopyToClipboard.Checked then
    Clipboard.Assign(SBmp);
end;

procedure TFormEnglishVoice.BtnDelSelectedClick(Sender: TObject);
begin
  SymbolDelete(SymbolSize, False, False);
end;

procedure TFormEnglishVoice.BtnDelAllClick(Sender: TObject);
begin
  SymbolFree;
  DrawVoice(SymbolSize, Image1.Picture.Bitmap);
end;

procedure TFormEnglishVoice.BtnLeftMoveClick(Sender: TObject);
begin
  SymbolMove(FSymbolIndex - 1);
end;

procedure TFormEnglishVoice.SetSymbolIndex(const Value: Integer);
begin
  FSymbolIndex := Value;
  BtnLeftMove.Enabled    := (FSymbolIndex <> -1) and (FSymbolIndex <> 0);
  BtnRightMove.Enabled   := (FSymbolIndex <> -1) and (FSymbolIndex <> ScrollBox1.ComponentCount - 1);
  BtnDelSelected.Enabled := (FSymbolIndex <> -1);
  BtnCopy.Enabled        := (ScrollBox1.ComponentCount <> 0);
  BtnDelAll.Enabled      := (ScrollBox1.ComponentCount <> 0);
end;

procedure TFormEnglishVoice.BtnRightMoveClick(Sender: TObject);
begin
  SymbolMove(FSymbolIndex + 1);
end;

procedure TFormEnglishVoice.editVoiceTextKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);

  function IsCapsLockKeyDown: Boolean;
  var
    KeyStates: TKeyboardState;
  begin
    GetKeyboardState(KeyStates);
    Result := odd(KeyStates[VK_CAPITAL]);
  end;

  function IsLowerCase(Shift: TShiftState): Boolean;
  begin
    Result := (IsCapsLockKeyDown and (ssShift in Shift))
              or (not IsCapsLockKeyDown and not (ssShift in Shift));
  end;

var
  btnTag, SymBolPerLine: Integer;
begin
  btnTag := -1;
  case Key of
    08: SymbolDelete(SymbolSize, True, True);
    37: begin
          if ssCtrl in Shift then
          begin
            SymbolMove(FSymbolIndex - 1);
          end
          else
          begin
            if ScrollBox1.ComponentCount > 0 then
              begin
              if SymbolIndex > 0 then
                SymbolOnClick(ScrollBox1.Components[FSymbolIndex - 1])
              else
                SymbolOnClick(ScrollBox1.Components[0]);
            end;
          end;
        end;
    38: begin
          SymBolPerLine := ScrollBox1.Width div ((SymbolSize + 2) * 2 + 1);
          if ssCtrl in Shift then
          begin
            SymbolMove(FSymbolIndex - SymBolPerLine);
          end
          else
          if SymbolIndex <> -1 then
          begin
            SymBolPerLine := ScrollBox1.Width div ((SymbolSize + 2) * 2 + 1);
            if (FSymbolIndex - SymBolPerLine) > - 1 then
            begin
              SymbolOnClick(ScrollBox1.Components[FSymbolIndex - SymBolPerLine]);
            end;
          end;
        end;
    39: begin
          if ssCtrl in Shift then
          begin
            SymbolMove(FSymbolIndex + 1);
          end
          else
          begin
            if ScrollBox1.ComponentCount > 0 then
            begin
              if SymbolIndex < ScrollBox1.ComponentCount - 1 then
                SymbolOnClick(ScrollBox1.Components[FSymbolIndex + 1]);
            end;
          end;
        end;
    40: begin
          SymBolPerLine := ScrollBox1.Width div ((SymbolSize + 2) * 2 + 1);
          if ssCtrl in Shift then
          begin
            SymbolMove(FSymbolIndex + SymBolPerLine);
          end
          else
          if SymbolIndex <> -1 then
          begin
            if (FSymbolIndex + SymBolPerLine) < ScrollBox1.ControlCount - 1 then
            begin
              SymbolOnClick(ScrollBox1.Components[FSymbolIndex + SymBolPerLine]);
            end;
          end;