インターネット巡回生活

ほぼほぼ、書きなぐり雑記かも

strToHex関数を作ろう

2006-10-27 | 日常
unit Unit2;

interface

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

type
TForm2 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
var WkByte : set of char;
var i,j,test : integer;
begin
WkByte := ['0'..'9', 'A'..'F', 'a'..'f'];
for I := 1 to length(edit1.Text) do
begin
WkByte:=copy(edit1.text,i,1);
test:= integer(ord(WkByte)) ;
edit2.text := edit2.text + format('%1d',[test]);
end;



{$IFDEF WIN32}
end;

end.
コメント
  • Twitterでシェアする
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

LF を CRLFにするプログラム by Delphi

2006-10-26 | 日常
//LF を CRLFにするサンプルプログラム

unit test2test;

interface

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

type
TForm2 = class(TForm)
Button1: TButton;
Edit1: TEdit;
OpenDialog1: TOpenDialog;
Button2: TButton;
Edit2: TEdit;
StatusBar1: TStatusBar;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;

var
Form2: TForm2;


implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
edit1.text:=OpenDialog1.FileName;
edit2.text:=ChangeFileExt(edit1.text,'.txt');
end
else
edit1.text:='';

end;

procedure TForm2.Button2Click(Sender: TObject);

var
FoutName: String;
Buf,wk_out : Byte;
Res,Res2 : Integer;
InPutF, OutPutF: File;
RecData: string;
ReadLength: integer;
ReadCnt : integer;
begin

// 初期化


// テキストファイル読み込み
FoutName:= edit2.text;
AssignFile( InPutF, edit1.text);
Reset(InPutF,1);
AssignFile(OutPutF, FoutName );
Rewrite(OutPutF,1);
ReadLength := 5000; //読み込み指定サイズ
SetLength(RecData, ReadLength);
ReadCnt := 0;
try
while not Eof( InPutF ) do // ファイルの終端までループ
begin
BlockRead(InPutF,PChar(RecData)^, ReadLength, Res);
if res <ReadLength then //指定サイズがファイルサイズより小さい場合 RecData:=AdjustLineBreaks(RecData);
BlockWrite(OutPutF,PChar(RecData)^,length(RecData),Res2);
if Res <ReadLength then ReadCnt := ReadCnt + 1;
if (ReadCnt mod 1000)= 0 then
statusbar1.SimpleText := Format('%1d',[ReadCnt]);
end;
finally
CloseFile(InPutF);
CloseFile(OutPutF);
end;

ShowMessage( '完了' );

end;

end.
コメント
  • Twitterでシェアする
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

ebcdicからasciiへのサンプル

2006-10-23 | 日常
unit test2test;

interface

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

type
TForm2 = class(TForm)
Button1: TButton;
Edit1: TEdit;
OpenDialog1: TOpenDialog;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;

var
Form2: TForm2;
wk_byte : array [0..255] of byte
= ( $00,$01,$02,$03,$9C,$09,$86,$7F,
$97,$8D,$8E,$0B,$0C,$0D,$0E,$0F,
$10,$11,$12,$13,$9D,$85,$08,$87,
$18,$19,$92,$8F,$1C,$1D,$1E,$1F,
$80,$81,$82,$83,$84,$0A,$17,$1B,
$88,$89,$8A,$8B,$8C,$05,$06,$07,
$90,$91,$16,$93,$94,$95,$96,$04,
$98,$99,$9A,$9B,$14,$15,$9E,$1A,
$20,$A0,$A1,$A2,$A3,$A4,$A5,$A6,
$A7,$A8,$D5,$2E,$3C,$28,$2B,$7C,
$26,$A9,$AA,$AB,$AC,$AD,$AE,$AF,
$B0,$B1,$21,$24,$2A,$29,$3B,$5E,
$2D,$2F,$B2,$B3,$B4,$B5,$B6,$B7,
$B8,$B9,$E5,$2C,$25,$5F,$3E,$3F,
$BA,$BB,$BC,$BD,$BE,$BF,$C0,$C1,
$C2,$60,$3A,$23,$40,$27,$3D,$22,
$C3,$61,$62,$63,$64,$65,$66,$67,
$68,$69,$C4,$C5,$C6,$C7,$C8,$C9,
$CA,$6A,$6B,$6C,$6D,$6E,$6F,$70,
$71,$72,$CB,$CC,$CD,$CE,$CF,$D0,
$D1,$7E,$73,$74,$75,$76,$77,$78,
$79,$7A,$D2,$D3,$D4,$5B,$D6,$D7,
$D8,$D9,$DA,$DB,$DC,$DD,$DE,$DF,
$E0,$E1,$E2,$E3,$E4,$5D,$E6,$E7,
$7B,$41,$42,$43,$44,$45,$46,$47,
$48,$49,$E8,$E9,$EA,$EB,$EC,$ED,
$7D,$4A,$4B,$4C,$4D,$4E,$4F,$50,
$51,$52,$EE,$EF,$F0,$F1,$F2,$F3,
$5C,$9F,$53,$54,$55,$56,$57,$58,
$59,$5A,$F4,$F5,$F6,$F7,$F8,$F9,
$30,$31,$32,$33,$34,$35,$36,$37,
$38,$39,$FA,$FB,$FC,$FD,$FE,$FF );



implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
edit1.text:=OpenDialog1.FileName
else
edit1.text:='';

end;

procedure TForm2.Button2Click(Sender: TObject);

var
FoutName: String;
Buf,wk_out : Byte;
Res : Integer;
InPutF, OutPutF: File;

begin

// 初期化


// テキストファイル読み込み
FoutName:= ChangeFileExt(edit1.text,'txt_out');
AssignFile( InPutF, edit1.text);
Reset(InPutF,1);
AssignFile(OutPutF, FoutName );
Rewrite(OutPutF,1);

while not Eof( InPutF ) do // ファイルの終端までループ
begin
BlockRead(InPutF,Buf,1,Res);
wk_out := wk_byte[word(buf)];
BlockWrite(OutPutF,wk_out,1,Res);

end;
CloseFile(InPutF);
CloseFile(OutPutF);

ShowMessage( '完了' );

end;

end.
コメント
  • Twitterでシェアする
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

delphi サンプル(テキストファイルを開いて別ファイルに書く)

2006-10-23 | 日常
//会社で使うサンプル
unit test2test;

interface

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

type
TForm2 = class(TForm)
Button1: TButton;
Edit1: TEdit;
OpenDialog1: TOpenDialog;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
edit1.text:=OpenDialog1.FileName
else
edit1.text:='';

end;

procedure TForm2.Button2Click(Sender: TObject);

var
FoutName: String;
LoadLine, LoadText: String;
stf, ltf: TextFile;
begin
// AssignFile,Writeln,Readln

// 初期化


// テキストファイル読み込み
FoutName:= ChangeFileExt(edit1.text,'txt_out');
AssignFile( ltf, edit1.text);
Reset( ltf );
AssignFile( stf, FoutName );
Rewrite( stf );

while not Eof( ltf ) do // ファイルの終端までループ
begin
Readln( ltf, LoadLine );
Writeln( stf, loadLine);

end;
CloseFile( ltf );
CloseFile( stf );

ShowMessage( '完了' );

end;

end.
コメント
  • Twitterでシェアする
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

一瞬も 一生も 美しく

2006-10-19 | 日常
資生堂CM「新しい私になって 篇」

一瞬も 一生も 美しく

出典(部分引用):http://www.youtube.com/watch?v=OteCtYvkJVU


ふられて化粧水付けたぐらいで忘れられるなら、幸せだろうね。
女性って、そういう面で切替力があると思うよ。
強いんだろうね。
男なら未練タラタラでしょうね。
男は弱いんだよね。


資生堂、企業CMに問合せ殺到!
コメント
  • Twitterでシェアする
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

グーグル・ドックス・アンド・スプレッドシーツ

2006-10-13 | 日常
グーグル、ネット上の文書作成や表計算機能を無料提供
米インターネット検索大手グーグルは11日、ネット上で
文書作成や表計算ができるサービス「グーグル・ドックス
・アンド・スプレッドシーツ」を始めた。
米マイクロソフト(MS)が販売する「オフィス」と似た機能を持ち、
MSに対抗する新サービスになる。パソコンにダウンロードできず
ネット上でしか利用できないが、無料なのが売り物だ。
MSの主力商品を脅かす存在になる可能性がある。

出典(部分引用):http://www.asahi.com/business/update/1012/091.html
朝日新聞

うーん。
できるだけ肯定的に考えてみたんですが、典型的に便利なシチェーションが
思い浮かばないです。
OOoじゃなくて、メール・ブログじゃなくてってゾーンって、
ニッチすぎないかなあ。
企業ユースにしても、Word、Excelのスケーラビリティってのが、
便利だったりするものなあ。


スプレットシートで、私の中ではお約束の割賦金計算
(不特定多数には、参照だけが許されて、入力(編集)は駄目みたい。
こういうシートは使いものになりませんね。名簿とかの用途かな?)
割賦金計算 - Google Docs & Spreadsheets
コメント
  • Twitterでシェアする
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

プログラマなこの頃

2006-10-08 | 日常
They're Back.

turboexplorer.com へようこそ! - 伝統ある「Turbo」ブランドは、
今、次世代プログラミングをサポートする先進テクノロジーとして
復活しました。
出典(部分引用):http://www.turboexplorer.com/jp

最新のbolandの開発環境が、機能限定で無料でつかうことが
できるようになって、かれこれ1ヶ月位になる。

今度の無料版は、商的利用もできるので、会社で試すことができる。
それなりに大きなプロジェクトで、EXCEL-VBAに限界を感じていたの
で、ちょっと試そうかなという誘惑で心が躍るが、踏み込んではいけない
道のようなきもする。

サンデープログラマとしも(仕事日はなかなかできませんね)、新しい
delphiでいくつか取り組んでいる。
タスクトレイに入る機能(常駐機能?)が標準でサポートされたので、
RRTを修正してテストしているが、たぶん大丈夫そうだ。今度の版では、
起動して一定時間経つとタスクトレイに入れることができる。
最小化で入らないのでダサいと思われそうだがよろしければ試してください。

buriburipipiのページ


もうひとつ新規のプログラムをやっていて、stringgridという機能を
初めて使っているので、遅々として進まない。大したプログラムでは
ないんですけどね。これがblogが不定期になってしまっている理由で
もあるんだが。


コメント (4)
  • Twitterでシェアする
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする