DouKaku? Language detail: Delphi

初めての投稿です。宜しくお願いします。 Delphiの投稿がないので。他の言語に比べると、やはり行数も長いですね。

program thread;

{$APPTYPE CONSOLE}

uses
  Classes, SyncObjs, SysUtils;

var
  csConsole: TCriticalSection;

procedure SerializeWrite(const s: string);
begin
  csConsole.Enter;
  try
    Write(s);
  finally
    csConsole.Leave;
  end;
  Sleep(1);
end;

type TWriteText = class(TThread)
  private
    FText: string;
  protected
    procedure Execute; override;
  public
    constructor Create(const Text: string);
end;

constructor TWriteText.Create(const Text: string);
begin
  inherited Create(true);
  FText := Text;
  Resume;
end;

procedure TWriteText.Execute;
var
  n: integer;
begin
  for n := 0 to Length(FText) - 1 do
    SerializeWrite(copy(FText, n + 1, 1));
end;

var
  threadWrite0To9: TWriteText;
  threadWriteAtoZ: TWriteText;
begin
  csConsole := TCriticalSection.Create;
  try
    threadWrite0To9 := TWrite0to9.Create('0123456789');
    threadWriteAtoZ := TWriteAtoZ.Create('ABCDEFGHIJ');
    try
      threadWrite0To9.WaitFor;
      threadWriteAtoZ.WaitFor;
    finally
      FreeAndNil(threadWrite0To9);
      FreeAndNil(threadWriteAtoZ);
    end;
  finally
    FreeAndNil(csConsole);
  end;
end.

LL Golf Hole 3 - 13日の金曜日を数え上げる (Nested Flatten)

あらためてDelphi(Pascal)で書いてみると。他の言語と比べて変数が多くなってしまう感じです。

現在、手元にDephiがなかったのでFree PascalのDelphi互換(-Mdelphiオプション)でコンパイルしています。

program Doukaku197;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  Day, Max: TDateTime;
  Y, M, D:  Word;
  I:        Integer;
begin
  Day := Date;
  Max := EncodeDate(2013, 12, 31);
  I   := 0;
  while Day <= Max do
  begin
    DecodeDate(Day, Y, M, D);
    if (D = 13) and (DayOfWeek(Day) = 6) then
    begin
      WriteLn(Y, '/', M, '/', D);
      Inc(I);
    end;
    Day := Day + 1;
  end;
  WriteLn(I, ' days');
end.

クリップボードへの転送 (Nested Flatten)

クリップボードの扱いを最初に覚えたDelphiで。

program doukaku188;

{$APPTYPE CONSOLE}

uses
  ClipBrd;

var
  S: String;
begin
  Clipboard.AsText := 'テキスト'; { copy  }
  S := Clipboard.AsText;          { paste }
  WriteLn(S);
end.

設定ファイルから値を取得 (Nested Flatten)

久々に使ったので、いろいろ忘れてます。
-- ShowPrice.ini
[doukaku186]
ITEM_NAME=りんご
ITEM_COST=200

program doukaku186;

{$APPTYPE CONSOLE}

uses
  IniFiles, SysUtils;

var
  Name: String;
  Cost: Integer;
begin
  with TIniFile.Create(ExtractFilePath(ParamStr((0)))+'\ShowPrice.ini') do
  begin
    try
      Name := ReadString('doukaku186', 'ITEM_NAME', '');
      Cost := ReadInteger('doukaku186', 'ITEM_COST', 0);
      WriteLn('「', Name, '」は', Cost * 105 div 100, '円（税込み）');
    finally
      Free;
    end;
  end
end.

自分自身のファイル名を知る方法 (Nested Flatten)

ファイル名だけ取得する場合。ExtractFilenameでファイル名だけ取り出します。

uses
  SysUtils;

begin
  Writeln(ExtractFilename(ParamStr(0)));
end.

1
2
3

begin
  Writeln(ParamStr(0));
end.

コマンドライン引数の取得 (Nested Flatten)

ParamCount関数でパラメータの個数を得られます。
ParamStr関数でパラメータ文字列を取得できます。
ParamStr(0)には起動したプログラムのパスが入ります。

program arguments;

{$APPTYPE CONSOLE}

var
  i: Integer;
begin
  for i := 1 to ParamCount do
  begin
    Write(ParamStr(i) + ' ');
  end;
  // => a b c d
end.

n人中m人が当選するくじ (Nested Flatten)

Integerの動的配列をtypeで定義しています。
Delphiは配列操作が苦手なので、できるだけ使わないようにしています。

type
  TDynIntArray = array of Integer;

function lot(n, m: Integer): TDynIntArray;
  function NumInArray(num: Integer; arr :TDynIntArray): Boolean;
  var
    x: Integer;
  begin
    Result := False;
    for x in arr do
      if x = num then
        Result := True;
  end;
var
  people: TDynIntArray;
  i: Integer;
  num_lot: Integer;
begin
  SetLength(people, m);
  Randomize;
  for i := 0 to m - 1 do
  begin
    repeat
      num_lot := Random(n) + 1;
    until not NumInArray(num_lot, people);
    people[i] := num_lot;
  end;
  Result := people;
end;

九九の表示 (Nested Flatten)

Formatを使わない場合。

program kuku;

{$APPTYPE CONSOLE}

var
  i, j: Integer;
  s: String;

begin
  for i := 1 to 9 do
    for j := 1 to 9 do
    begin
      Str(i * j:2, s);
      WriteLn(i, ' * ', j, ' = ' + s);
    end;
end.

DelphiにはFormatがあるが、これは劣化版sprintfみたいなもの。

program kuku;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  i, j: Integer;

begin
  for i := 1 to 9 do
    for j := 1 to 9 do
      WriteLn(Format('%d * %d = %2d', [i, j, i * j]));
end.

リストを逆順に表示 (Nested Flatten)

うーむ、Delphiで短く書くのは難しい…。

program gerogero;

{$APPTYPE CONSOLE}

procedure WriteReverse(const given_list: array of Integer);
var
    i: Integer;
begin
    for i := High(given_list) downto Low(given_list) do
        Writeln(given_list[i]);
end;

begin
    WriteReverse([1, 2, 3, 4, 5]);
end.

ウィンドウの表示 (Nested Flatten)

program window;

uses
    Forms;

var
    Form: TForm;

begin
    Application.Initialize;
    Application.CreateForm(TForm, Form);
    Form.Caption := 'こんにちは、GUI！';
    Form.BorderStyle := bsToolWindow;
    Form.SetBounds(0, 0, 100, 75);
    Form.Position := poScreenCenter;
    Application.Run;
end.

長方形の交差判定 (Nested Flatten)

Delphiのくせに短く書けるなんて…！
重なっていた場合、rには位置X,Y,幅,高さが返ります。

program InterSEICROSS;

{$APPTYPE CONSOLE}

uses
    Types;

const
    Rect1: TRect = (Left: 0; Top: 0; Right: 100; Bottom: 100);
    Rect2: TRect = (Left: 100; Top: 0; Right: 200; Bottom: 100);
    Rect3: TRect = (Left: 0; Top: 50; Right: 100; Bottom: 150);

var
    r: TRect;

begin
    Writeln('Overlapped: ', IntersectRect(r, Rect1, Rect2));
    Writeln('Overlapped: ', IntersectRect(r, Rect1, Rect3));
end.

RFC 4180対応版 CSVレコードの分解 (Nested Flatten)

program splitter;

{$APPTYPE CONSOLE}

uses
    Classes;

procedure splitCSV(const Text: String);
var
    i: Integer;
    sl: TStringList;
begin
    sl := TStringList.Create;
    try
        sl.CommaText := Text;
        for i := 0 to sl.Count-1 do
            Writeln(i+1, ' => ', sl[i]);
    finally
        sl.Free;
    end;
end;

begin
    splitCSV('"aaa","b'#13#10'bb","ccc",zzz,"y""Y""y",xxx');
end.

メソッド名一覧の表示 (Nested Flatten)

いけるのはpublishedで宣言されたもののみです。
ちなみにお題のタイトルのようにメソッド名一覧を表示する場合は、
Pos関数内で使ってるPShortString(...)^をWritelnしてやればOKです。

program EnumMethodNames;

{$APPTYPE CONSOLE}

type
    THoge = class(TObject)
    published
        procedure test_foo;
    end;
    THogeEx = class(THoge)
    published
        procedure test_bar;
        procedure foobar;
    end;
    THogeMethod = procedure of object;

procedure THoge.test_foo;
begin
    Writeln('foo');
end;

procedure THogeEx.test_bar;
begin
    Writeln('bar');
end;

procedure THogeEx.foobar;
begin
    Writeln('foobar');
end;

procedure EnumMethods(target: TObject);
var
    ref: TClass;
    table: PChar;
    count: Word;
    method: TMethod;
begin
    ref := target.ClassType;
    while ref <> nil do begin
        table := PPointer(PChar(ref) + vmtMethodTable)^;
        if Assigned(table) then begin
            count := PWord(table)^;
            Inc(table, SizeOf(Word));
            while count > 0 do begin
                if Pos('test_', PShortString(table+SizeOf(Word)+SizeOf(Pointer))^) = 1 then begin
                    method.Code := PPointer(table+SizeOf(Word))^;
                    method.Data := target;
                    THogeMethod(method);
                end;
                Inc(table, PWord(table)^);
                Dec(count);
            end;
        end;
        ref := ref.ClassParent;
    end;
end;

var
    Hoge: THoge;

begin
    Hoge := THogeEx.Create;
    try
        EnumMethods(Hoge);
    finally
        Hoge.Free;
    end;
end.

ピラミッドを作る (Nested Flatten)

program Hoge;

{$APPTYPE CONSOLE}

procedure Pyramid(n: Integer);
var
    i: Integer;
begin
	for i := 1 to n do
		Writeln(StringOfChar(' ', n-i), StringOfChar('*', i*2-1));
end;

begin
	Pyramid(5);
end.

Hello, world! (Nested Flatten)

Delphiのコンソールアプリケーションでは、$APPTYPE CONSOLEを指定しないとエラーになります。

program hello;
{$APPTYPE CONSOLE}
begin
  WriteLn('Hello, world!');
end.

DouKaku?

Language detail: Delphi

Unsolved challenges

codes

Index

Feed

Other

Link

Pathtraq