@echo off
set thisdir=%~dp0
set exepath="%thisdir%plCmdFont.exe"
%exepath% /color=$0B /fontname="ＭＳ ゴシック" /fontsize=25
@echo on

@echo off
D:\000\plCmdFont.exe /color=$0B /fontname="ＭＳ ゴシック" /fontsize=25
@echo on

//=============================================================================
//  バッチファイルを指定してコマンドプロンプトを起動
//  バッチファイルはコマンドプロンプトのフォントサイズ等の設定用
//
//  usesにShellAPIが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LAppPath  : string;
  LParamStr : string;
begin
  LAppPath  := 'cmd.exe';
  LParamStr := '/k ' + AnsiQuotedStr(ExpandFileName('SetFont.bat'), '"');

  ShellExecute(Handle, '', Pchar(LAppPath), PChar(LParamStr), nil, SW_SHOW);
end;

//=============================================================================
//  plCmdFont.exeのパラメータを指定してコマンドプロンプトを起動する例
//
//  usesにShellAPIが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LAppPath  : string;
  LParamStr : string;
begin
  LAppPath  := 'cmd.exe';

  //起動パラメータの中に"(ダブルクォーテーション)が必要な場合
  //全体を"(ダブルクォーテーション)で括る
  LParamStr := '/k '
             + '"' + AnsiQuotedStr(ExpandFileName('plCmdFont.exe'), '"')
             + ' /color=$1F /fontname="ＭＳ ゴシック" /fontsize=16' + '"';

  ShellExecute(Handle, '', Pchar(LAppPath), PChar(LParamStr), 'C:\', SW_SHOW);
end;

program plCmdFont;
{$APPTYPE CONSOLE}



{$R *.dres}

uses
  Dialogs,
  SysUtils,
  Windows,
  DWMAPI,
  Messages,
  Classes;

//-----------------------------------------------------------------------------
//  SetCurrentConsoleFontEx関数とこの関数で使用する構造体の定義
//  これらはDelphi XE7 までは実装されていない.Windows Vista以降で使用可能
//-----------------------------------------------------------------------------
type
  PConsoleFontInfoEx = ^TConsoleFontInfoEx;
  _CONSOLE_FONT_INFOEX = record
    cbSize     : ULONG;
    nFont      : DWORD;
    dwFontSize : TCoord;
    FontFamily : UINT;
    FontWeigth : UINT;
    FontName   : array [0..LF_FACESIZE-1] of WideChar;
  end;
  TConsoleFontInfoEx = _CONSOLE_FONT_INFOEX;

  function GetCurrentConsoleFontEx(
            hConsoleOutput : THandle;
            bMaximumWindow : BOOL;
            lpConsoleCurrentFontEx : PConsoleFontInfoEx):
            BOOL; stdcall; external 'kernel32.dll';

  function SetCurrentConsoleFontEx(
            hConsoleOutput : THandle;
            bMaximumWindow : BOOL;
            lpConsoleCurrentFontEx : PConsoleFontInfoEx):
            BOOL; stdcall; external 'kernel32.dll';

const
  FMaxValue = MaxInt div 2;
  FWndClassName = 'ConsoleWindowClass';

//-----------------------------------------------------------------------------
//  Windows Vista以降では，フォームのフレームの仕様が拡張されている
//  これを考慮したウィンドウのTRect構造体の値を取得
//  usesにDWMAPIが必要
//-----------------------------------------------------------------------------
function GetWindowRectForVista(hWindow: HWND): TRect;
var
  LRect : TRect;
begin
  //拡張したウィンドウのフレームのTRect構造体の値を取得
  DwmGetWindowAttribute(hWindow,
                        DWMWA_EXTENDED_FRAME_BOUNDS,
                        @LRect,
                        SizeOf(TRect));
  Result := LRect;
end;

//=============================================================================
//  コマンドライン起動オプションの指定例
//
//  plCmdFont.exe /color=$9F /fontname="ＭＳ ゴシック" /fontsize=16
//  plCmdFont.exe /color=$1F /fontname="Terminal" /fontsize=16
//  plCmdFont.exe /color=$0F /wndleft=0 /wndtop=0
//=============================================================================
var
  LArgList      : TStringList;
  LResStream    : TResourceStream;
  LArgText      : string;
  LiPos         : Integer;
  LLeftStr      : string;
  LRightStr     : string;
  LWndRect      : TRect;
  LArgWndLeft   : Integer;
  LArgWndTop    : Integer;
  LArgBuffW     : Integer;
  LArgBuffH     : Integer;
  LArgWndW      : Integer;
  LArgWndH      : Integer;
  LArgFontH     : Integer;
  LArgFontName  : string;
  LArgColor     : Integer;
  LColorWord    : Word;
  LConsoleWnd   : HWND;
  LhStdout      : THandle;
  LCurPos       : TCoord;
  LBuffCoord    : TCoord;
  LWndCoord     : TCoord;
  LSmallRect    : TSmallRect;
  LFontInfo     : TConsoleFontInfoEx;
  LBuffInfo     : TConsoleScreenBufferInfo;
  LBuffLength   : Cardinal;
  LOutCnt       : Cardinal;
  i             : Integer;
  LShowHide     : Boolean;
  LShowBuffInto : Boolean;
  LShowWndInfo  : Boolean;
  LShowFontInfo : Boolean;
begin
  LArgWndLeft   := FMaxValue;
  LArgWndTop    := FMaxValue;
  LArgBuffW     := FMaxValue;
  LArgBuffH     := FMaxValue;
  LArgWndW      := FMaxValue;
  LArgWndH      := FMaxValue;
  LArgFontH     := FMaxValue;
  LArgColor     := FMaxValue;
  LArgFontName  := '';
  LShowHide     := False;
  LShowBuffInto := False;
  LShowWndInfo  := False;
  LShowFontInfo := False;

  //起動オプション全体を文字列として取得
  LArgText := '';
  for i := 1 to ParamCount do begin
    LArgText := LArgText + ParamStr(i);
  end;

  //プロパティのダイアログを表示
  if (Trim(LArgText) = '/') then begin
    keybd_event(VK_MENU,  MapVirtualKey(VK_MENU, 0),  0, 0);
    keybd_event(VK_SPACE, MapVirtualKey(VK_SPACE, 0), 0, 0);
    keybd_event(Ord('P'), MapVirtualKey(Ord('P'), 0), 0, 0);

    keybd_event(VK_MENU,  MapVirtualKey(VK_MENU, 0),  KEYEVENTF_KEYUP, 0);
    keybd_event(VK_SPACE, MapVirtualKey(VK_SPACE, 0), KEYEVENTF_KEYUP, 0);
    keybd_event(Ord('P'), MapVirtualKey(Ord('P'), 0), KEYEVENTF_KEYUP, 0);
  end;

  //パラメータの説明を表示
  //テキストはリソースとしてEXEに埋め込んでいる
  if (Trim(LArgText) = '/?') or (Trim(LArgText) = '?') then begin
    LResStream := TResourceStream.Create(hInstance,'Resource_1','TEXT');
    LArgList := TStringList.Create;
    try
      LArgList.LoadFromStream(LResStream);
      Writeln(LArgList.Text);
    finally
      FreeAndNil(LArgList);
      FreeAndNil(LResStream);
    end;
    exit;
  end;

  //------------------------------------------------------------------------
  //  各起動パラメータ(起動オプション)の値を取り出す処理
  //------------------------------------------------------------------------

  LArgList := TStringList.Create;
  try
    LArgList.Delimiter       := '/';
    LArgList.StrictDelimiter := True;
    LArgList.DelimitedText   := LArgText;

    try
      if ParamCount = 0 then begin
        LShowFontInfo := True;
      end else
      if (ParamCount = 1) and (LArgList.Count = 1) then begin
        LArgFontH := StrToIntDef(ParamStr(1), FMaxValue);;
        LShowFontInfo := True;
      end else begin
        for i := 0 to LArgList.Count - 1 do begin
          LArgText  := LArgList[i];
          if Pos('fontname', LowerCase(LArgText)) <= 0 then begin
            LArgText := LowerCase(LArgList[i]);
          end;
          LiPos     := Pos('=', LArgText);
          LLeftStr  := Copy(LArgText, 1, LiPos);
          LLeftStr  := StringReplace(LLeftStr, ' ', '', [rfReplaceAll]);
          LRightStr := Trim(Copy(LArgText, LiPos + 1, Length(LArgText)));
          if Length(LRightStr) = 0 then Continue;

          //ウィンドウの左端X座標値
          if (LLeftStr ='wndleft=') or (LLeftStr = 'windowleft=') then begin
            LArgWndLeft := StrToIntDef(LRightStr, FMaxValue);
          end;
          //ウィンドウの上端Y座標値
          if (LLeftStr = 'wndtop=') or (LLeftStr = 'wndowtop=') then begin
            LArgWndtop := StrToIntDef(LRightStr, FMaxValue);
          end;
          //画面バッファのサイズの幅
          if (LLeftStr = 'buffw=') or (LLeftStr = 'bufferw=') then begin
            LArgBuffW := StrToIntDef(LRightStr, FMaxValue);
          end;
          //画面バッファのサイズの高さ
          if (LLeftStr = 'buffh=') or (LLeftStr = 'bufferh=') then begin
            LArgBuffH:= StrToIntDef(LRightStr, FMaxValue);
          end;
          //ウィンドウのサイズの幅
          if (LLeftStr = 'wndw=') or (LLeftStr = 'windoww=') then begin
            LArgWndW := StrToIntDef(LRightStr, FMaxValue);
          end;
          //ウィンドウのサイズの高さ
          if (LLeftStr = 'wndh=') or (LLeftStr = 'windowh=') then begin
            LArgWndH:= StrToIntDef(LRightStr, FMaxValue);
          end;
          //フォント高さ
          if LLeftStr = 'fontsize=' then begin
            LArgFontH := StrToIntDef(LRightStr, FMaxValue);;
          end;
          //背景色とフォントの色
          if LLeftStr = 'color=' then begin
            if LRightStr[1] <> '$' then LRightStr := '$' + LRightStr;
            LArgColor := StrToIntDef(LRightStr, FMaxValue);
          end;
          //フォント名
          if LLeftStr = 'fontname=' then begin
            LArgFontName := Trim(LRightStr);
          end;
          //非表示オプション
          if LRightStr = 'hide' then begin
            LShowHide := True;
          end;
        end;
      end;
    finally
      FreeAndNil(LArgList);
    end;
  except
    exit;
  end;
  //以上で起動パラメータの値が変数に代入された．これ以降は実際の設定コード


  //------------------------------------------------------------------------
  //  ウインドウの位置の設定
  //------------------------------------------------------------------------

  //ウインドウハンドルを取得
  LConsoleWnd := FindWindow(PChar(FWndClassName), nil);
  if LConsoleWnd > 0 then begin
    //コンソールウィンドウのサイズ(ピクセル)を取得して位置を設定
    LWndRect := GetWindowRectForVista(LConsoleWnd);

    if LArgWndLeft >= FMaxValue then begin
      LArgWndLeft := LWndRect.Left;
    end;
    if LArgWndTop >= FMaxValue then begin
      LArgWndTop := LWndRect.Top;
    end;
    MoveWindow(LConsoleWnd,
               LArgWndLeft,
               LArgWndTop,
               LWndRect.Right  - LWndRect.Left,
               LWndRect.Bottom - LWndRect.Top,
               True);
  end;


  //標準出力デバイスのハンドルを取得
  LhStdout := GetStdHandle(STD_OUTPUT_HANDLE);
  if LhStdout > 0 then begin

    //------------------------------------------------------------------------
    //  画面バッファのサイズの幅と高さ
    //  ウィンドウの幅と高さよりも小さい値にはできない
    //  システムが設定している最小値より小さい値にはできない(SM_CXMIN, SM_CYMIN)
    //  システムが設定している最大値よりも大きな値にはできない
    //------------------------------------------------------------------------

    if (LArgBuffW < FMaxValue) or (LArgBuffH < FMaxValue) then begin
      if not LShowHide then LShowBuffInto := True;

      //バッファの情報取得
      GetConsoleScreenBufferInfo(LhStdout, LBuffInfo);

      LBuffCoord.X := LBuffInfo.dwSize.X;
      LBuffCoord.Y := LBuffInfo.dwSize.Y;
      if LArgBuffW < FMaxValue then LBuffCoord.X := LArgBuffW;
      if LArgBuffH < FMaxValue then LBuffCoord.Y := LArgBuffH;
      SetConsoleScreenBufferSize(LhStdout, LBuffCoord);

      //設定結果の表示
      if LShowBuffInto then begin
        GetConsoleScreenBufferInfo(LhStdout, LBuffInfo);
        writeln('');
        Writeln('Buffer W : ' + IntToStr(LBuffInfo.dwSize.X));
        Writeln('Buffer H : ' + IntToStr(LBuffInfo.dwSize.Y));
      end;
    end;

    //------------------------------------------------------------------------
    //  ウィンドウのサイズの幅と高さ
    //  画面バッファのサイズよりも大きな値にはできない
    //  大きな値を設定したい場合は，画面バッファのサイズを設定してから変更する
    //
    //  ネット上に
    //  TConsoleScreenBufferInfo.srWindow.Left
    //  TConsoleScreenBufferInfo.srWindow.Top
    //  の値を(0, 0) または(1,1)にするサンプルコードがある．それでも変更は可能
    //  ただし，その値で設定を繰り返すと例外が発生する
    //  例外が発生すると，コマンドプロンプトが終了できなくなる
    //  システム関係のこの例外はtry-exceptでは捕捉できない
    //------------------------------------------------------------------------

    if (LArgWndW < FMaxValue) or (LArgWndH < FMaxValue) then begin
      if not LShowHide then LShowWndInfo := True;
      //バッファの情報取得
      GetConsoleScreenBufferInfo(LhStdout, LBuffInfo);

      LSmallRect := LBuffInfo.srWindow;
      if LArgWndW < FMaxValue then LSmallRect.Right  := LSmallRect.Left + LArgWndW - 1;
      if LArgWndH < FMaxValue then LSmallRect.Bottom := LSmallRect.Top + LArgWndH - 1;
      SetConsoleWindowInfo(LhStdout, True, LSmallRect);

      //設定結果の表示
      if LShowWndInfo then begin
        GetConsoleScreenBufferInfo(LhStdout, LBuffInfo);
        LWndCoord.X := LBuffInfo.srWindow.Right - LBuffInfo.srWindow.Left + 1;
        LWndCoord.Y := LBuffInfo.srWindow.Bottom - LBuffInfo.srWindow.Top + 1;
        if not LShowBuffInto then writeln('');
        Writeln('Window W : ' + IntToStr(LWndCoord.X));
        Writeln('Window H : ' + IntToStr(LWndCoord.Y));
      end;
    end;

    //------------------------------------------------------------------------
    //  フォントサイズとフォント名の取得と設定
    //  フォント名とサイズの組み合わせによっては設定できない組み合せもある
    //  プロパティのフォントのリストにないフォント名は指定できない
    //------------------------------------------------------------------------

    //フォント情報構造体のサイズ設定
    LFontInfo.cbSize := SizeOf(TConsoleFontInfoEx);

    if (LArgFontH < FMaxValue) or (LArgFontName <> '') then begin
      if not LShowHide then LShowFontInfo := True;

      //現在のフォント情報を取得
      GetCurrentConsoleFontEx(LhStdout, False, @LFontInfo);

      //フォントサイズ
      if (LArgFontH <= 72) then begin
        LFontInfo.dwFontSize.X := 0;
        LFontInfo.dwFontSize.Y := LArgFontH;
      end;
      //フォント名
      if LArgFontName <> '' then begin
        StrPCopy(LFontInfo.FontName, LArgFontName);
        LFontInfo.nFont        := 0;
        LFontInfo.FontFamily   := FF_DONTCARE;
        LFontInfo.FontWeigth   := FW_DONTCARE;
      end;
      //新しいフォントを設定
      SetCurrentConsoleFontEx(LhStdout, False, @LFontInfo);
    end;

    //現在のフォントの設定値を表示
    if LShowFontInfo then begin
      //フォントの設定を取得
      GetCurrentConsoleFontEx(LhStdout, False, @LFontInfo);
      if not (LShowBuffInto and LShowWndInfo) then writeln('');
      Writeln('FontName   : ' + LFontInfo.FontName);
      Writeln('FontSize.X : ' + IntToStr( LFontInfo.dwFontSize.X));
      Writeln('FontSize.Y : ' + IntToStr( LFontInfo.dwFontSize.Y));
    end;

    //------------------------------------------------------------------------
    //  画面の背景色と文字の色の設定
    //  cmd.exeにはcolorという内部コマンドがある.そのコマンドで設定可能
    //  cmd.exeの起動オプションの/Tでも設定可能
    //------------------------------------------------------------------------

    //最初の４ビットが背景色.下位の4ビットが文字の色
    if LArgColor <= $FF then begin
      //バッファの情報取得
      GetConsoleScreenBufferInfo(LhStdout, LBuffInfo);
      LBuffCoord := LBuffInfo.dwSize;

      LColorWord := LArgColor and $FF;
      LCurPos.X := 0;
      LCurPos.Y := 0;
      LBuffLength := LBuffCoord.X * LBuffCoord.Y;
      FillConsoleOutputAttribute(LhStdout, LColorWord, LBuffLength, LCurPos, LOutCnt);
      SetConsoleTextAttribute(LhStdout, LColorWord);
    end;
  end;
end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin;

type
  TForm1 = class(TForm)
    Button1: TButton;
    SpinEdit1: TSpinEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    FhCmdWindow : HWND;
  end;

var
  Form1: TForm1;

implementation

uses
  ShellAPI;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  SetCurrentConsoleFontEx関数とこの関数で使用する構造体の定義
//  これらはDelphi XE7 までは実装されていない.Windows Vista以降で使用可能
//-----------------------------------------------------------------------------
type
  PConsoleFontInfoEx = ^TConsoleFontInfoEx;
  _CONSOLE_FONT_INFOEX = record
    cbSize     : ULONG;
    nFont      : DWORD;
    dwFontSize : TCoord;
    FontFamily : UINT;
    FontWeigth : UINT;
    FontName   : array [0..LF_FACESIZE-1] of WideChar;
  end;
  TConsoleFontInfoEx = _CONSOLE_FONT_INFOEX;

  function GetCurrentConsoleFontEx(
            hConsoleOutput : THandle;
            bMaximumWindow : BOOL;
            lpConsoleCurrentFontEx : PConsoleFontInfoEx):
            BOOL; stdcall; external 'kernel32.dll';

  function SetCurrentConsoleFontEx(
            hConsoleOutput : THandle;
            bMaximumWindow : BOOL;
            lpConsoleCurrentFontEx : PConsoleFontInfoEx):
            BOOL; stdcall; external 'kernel32.dll';

  function AttachConsole(dwProcess: DWORD): BOOL; stdcall; external 'kernel32.dll';


//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  SpinEdit1.MinValue := 10;
  SpinEdit1.MaxValue := 72;
  SpinEdit1.Value    := 16;
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if FhCmdWindow > 0 then begin
    if IsWindowVisible(FhCmdWindow) then begin
      PostMessage(FhCmdWindow, WM_CLOSE, 0, 0);
    end;
  end;
end;

//=============================================================================
//  コマンドプロンプトを起動
//
//  usesにShellAPIが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LAppPath  : string;
  LParamStr : string;
begin
  FhCmdWindow := FindWindow('ConsoleWindowClass', nil);
  if IsWindowVisible(FhCmdWindow) then begin
    SpinEdit1.SetFocus;
    exit;
  end;

  LAppPath  := 'cmd.exe';
  LParamStr := '';

  ShellExecute(Handle, '', Pchar(LAppPath), PChar(LParamStr), 'C:\', SW_SHOW);

  //起動待ちのタイムラグ(簡易版)
  Sleep(200);
  SetForegroundWindow(Handle);
  SpinEdit1.SetFocus;
end;

//=============================================================================
//  SpinEdit1のOnChangeイベント
//  コマンドプロンプトのフォントサイズをSpinEdit1の値にする
//=============================================================================
procedure TForm1.SpinEdit1Change(Sender: TObject);
var
  LProcessID  : Cardinal;
  LhStdout    : THandle;
  LFontInfo   : TConsoleFontInfoEx;
begin
  //コマンドプロンプトのウインドウハンドルを取得
  FhCmdWindow := FindWindow('ConsoleWindowClass', nil);
  if FhCmdWindow = 0 then exit;
  //スレッドのプロセスIDを取得
  GetWindowThreadProcessId(FhCmdWindow, @LProcessID);

  //コンソールのスレッドにアタッチ
  if AttachConsole(LProcessID) then begin
    //標準出力デバイスのハンドルを取得
    LhStdout := GetStdHandle(STD_OUTPUT_HANDLE);
    if LhStdout > 0 then begin

      //------------------------------------------------------------------------
      //  フォントサイズとフォント名の取得と設定
      //  フォント名とサイズの組み合わせによっては設定できない組み合せもある
      //------------------------------------------------------------------------

      //フォント情報構造体のサイズ設定
      LFontInfo.cbSize := SizeOf(TConsoleFontInfoEx);
      //現在のフォント情報を取得
      GetCurrentConsoleFontEx(LhStdout, False, @LFontInfo);

      //フォントサイズ
      LFontInfo.dwFontSize.X := 0;
      LFontInfo.dwFontSize.Y := SpinEdit1.Value;
      LFontInfo.nFont        := 0;
      LFontInfo.FontFamily   := FF_DONTCARE;
      LFontInfo.FontWeigth   := FW_DONTCARE;

      //新しいフォントを設定
      SetCurrentConsoleFontEx(LhStdout, False, @LFontInfo);
    end;

    //FreeConsoleでデアタッチしておく
    FreeConsole;
  end;
end;

end.