スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

UDPによる通信プログラム

UDPによる通信プログラムのサンプルが無かったので自前で作成。
環境:Delphi2007 + Indy10.5.8.0
日本語のメッセージにも対応しています。

//===========================================================
//サーバー側
//===========================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  IdUDPServer1.DefaultPort := 12345;
  IdUDPServer1.BroadcastEnabled := True;
  IdUDPServer1.OnUDPRead := IdUDPServer1UDPRead; // 受信時のイベント
  IdUDPServer1.Active := True;
end;


procedure TForm1.IdUDPServer1UDPRead(AThread: TIdUDPListenerThread;
const AData: TIdBytes; ABinding: TIdSocketHandle);
var
  a: string;
  s: string;

begin
  // Indyのデフォルト文字コードを設定
  IdGlobal.GIdDefaultAnsiEncoding := encUTF8;

  // エンコードを指定してバイト配列を文字列に変換する。
  s := BytesToString(AData, enUTF8);
  a := Utf8ToAnsi(s); // UnicodeをAnsiに変換する。

  Memo1.Lines.Add(ABinding.PeerIP + ' ' + a);
  // ABinding.PeerIP には送信元のIPが格納されています。
  // ABinding.PeerPort には送信元のポートが格納されています。
end;


//===========================================================
//クライアント側
//===========================================================
ボタンなどでのクリックイベントで実装してください。
// コンピュータ名からIPアドレスを取得する。
sServerIP := GetIpAddress(sCPNM);

// Indyのデフォルト文字コードを設定
IdGlobal.GIdDefaultAnsiEncoding := encUTF8;

// サーバーがあるか確認する
myUDPClient := TIdUDPClient.Create(nil);
myUDPClient.Active := True;
myUDPClient.BroadcastEnabled := True;
myUDPClient.ReceiveTimeout := 500;
myUDPClient.Host := sServerIP;
myUDPClient.Port := 12345;
myUDPClient.Send('Server'#13#10, enUTF8);

myUDPClient.Active := False;
myUDPClient.Disconnect;
myUDPClient.Free;



function GetIpAddress(HostName : String) : String;
var
  PH : PHostEnt;
  InAddr: TInAddr;
  WSADATA : TWSADATA;
begin
  Result := '';
  if HostName = '' then exit;
  WSAStartup(MakeWord(1,1), WSADATA);

  PH := gethostbyname(PChar(HostName));

  if PH = nil then Exit;
  InAddr := PInAddr(ph^.h_addr_list^)^;
  Result := inet_ntoa(InAddr);
  WSACleanup;
end;

ランキングに参加しています。
クリックのご協力をお願い致します。
いつもありがとうございます。

にほんブログ村 通販ブログへ
にほんブログ村
ブログランキング・にほんブログ村へ
にほんブログ村
にほんブログ村 IT技術ブログ ソフトウェアへ
にほんブログ村
にほんブログ村 ゲームブログへ
にほんブログ村
にほんブログ村 IT技術ブログへ
にほんブログ村

スポンサーサイト

TTreeViewとフォームの連動

MDIフォームにTTreeViewコンポーネントを配置し、各ノードとMDI子フォームを連動させる必要がでてきたので、
フォームのTagプロパティを使って連動してみました。
「Tag プロパティを使って追加の整数値を格納したり、
 Tag プロパティをコンポーネント参照またはポインタなどの 32 バイト値に型キャストしたりできます。」
となっていますので、ポインタとして利用すればできそうです。


// ============================================================================
// ノードの追加とMDI子フォームの表示
// ============================================================================
procedure TFM_MainForm.NodeAdd(iSiteNo: Integer; iPageNo: Integer);
var
sMsg : String;
rootnode : TTreeNode;
node : TTreeNode;
ChildT : TFM_MDIChild_TOP;//メインの子フォーム
ChildS : TFM_MDIChild_SUB;//サブの子フォーム

begin
if iPageNo = 1 then
begin
// ルートノードの追加
node := TreeView1.Items.Add(nil, 'トップページ');
with node do
begin
ImageIndex := 0;
SelectedIndex := 0;
Selected := True;
end;

// サブフォームを生成する(トップページ用)
ChildT := TFM_MDIChild_TOP.Create(Application);
ChildT.Tag := iPageNo;
ChildT.DataDisp(sMsg);
end else
begin
// サブノードの追加
rootnode := FindRootNode(TreeView1);
node := TreeView1.Items.AddChild(rootnode, 'サブページ');
with node do
begin
ImageIndex := 0;
SelectedIndex := 0;
end;

// 親ノードを展開
node.Parent.Expand(True);

node.Selected := True;

// サブフォームを生成する(サブページ用)
ChildS := TFM_MDIChild_SUB.Create(Application);
ChildS.Tag := iPageNo;
ChildS.DataDisp(sMsg);
end;

// ノードの Data にポインターをセット (Integer型をPointer型にキャスト)
node.Data := Pointer(iPageNo);
end;

// ============================================================================
// ノードクリック
// ============================================================================
procedure TFM_MainForm.TreeView1Click(Sender: TObject);
var
ii : Integer;
node : TTreeNode;

begin
// nul ではないことを確認
if Assigned(TreeView1.Selected) then
begin
// 選択しているノードを取得
node := TreeView1.Selected;
if node.Data = nil then exit;

// Node.Dataに格納しているインデックスからサブフォームを列挙する。
for ii := 0 to MDIChildCount - 1 do
begin
if MDIChildren[ii].Tag = Integer(Node.Data) then
begin
MDIChildren[ii].Show;
Break;
end;
end;
end;
end;


追加したノードに対して、ひとつの子フォームを割り当てていきますので、
子フォーム内に処理を記述しておけば、
共通処理を行えます。

ランキングに参加しています。
クリックのご協力をお願い致します。
いつもありがとうございます。
にほんブログ村 IT技術ブログへ
にほんブログ村

TDBGridにチェックボックスの列を追加する

procedure TForm1.DBGrid1CellClick(Column: TColumn);
var
  Pt: TPoint;
  Coord: TGridCoord;
  ClickCol: Integer;
begin
  Pt := DBGrid1.ScreenToClient(Mouse.CursorPos);
  Coord := DBGrid1.MouseCoord(Pt.X, Pt.Y);
  ClickCol := Coord.X;
  if ClickCol = 1 then
  begin
   Column.Field.DataSet.Edit;
   Column.Field.AsBoolean := not Column.Field.AsBoolean;
  end;
end;

procedure TForm1.DBGrid1ColEnter(Sender: TObject);
begin
 if TDBGrid(Sender).SelectedField.DataType = ftBoolean then
  TDBGrid(Sender).Options := TDBGrid(Sender).Options - [dgEditing]
 else
  TDBGrid(Sender).Options := TDBGrid(Sender).Options + [dgEditing];
end;

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
 R: TRect;
begin
 if Column.Field.DataType = ftBoolean then
 begin
 TDBGrid(Sender).Canvas.FillRect(Rect);
  R := Rect;
  InflateRect(R, -1, -1);
  if Column.Field.AsBoolean then
   DrawFrameControl(TDBGrid(Sender).Canvas.Handle, R, DFC_BUTTON,
   DFCS_BUTTONCHECK + DFCS_CHECKED)
  else
   DrawFrameControl(TDBGrid(Sender).Canvas.Handle, R, DFC_BUTTON,
   DFCS_BUTTONCHECK);
  end;
end;


ランキングに参加しています。
クリックのご協力をお願い致します。
いつもありがとうございます。
にほんブログ村 IT技術ブログへ
にほんブログ村

TDBCtrlGrid上のTDBEditで全選択状態にするには

カーソル移動時に入力済み文字列を全選択したい場合がありますが、
ENTERキーによるカーソル移動時には、キーをTABキーに置換すればいいんだけど、
上下キーの場合はPostMessageしてあげる必要があります。

procedure TFM_Form.DBCtrlGridMeisaiKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
cCur : TControl;
begin

if ((Sender.ClassName = 'TDBCtrlGrid') = False) then
begin
cCur := screen.ActiveControl;

case Key of
VK_RETURN, VK_TAB:
begin
if (key = VK_RETURN) then Key := VK_TAB;
end;
VK_DOWN:
begin
DM_Mitumorisyo.tblMITUMEISAI.Next;
if (cCur is TDBEdit) then PostMessage((cCur as TDBEdit).Handle, EM_SETSEL, 0, Length((cCur as TDBEdit).Text));
if (cCur is TDBEditFC) then PostMessage((cCur as TDBEditFC).Handle, EM_SETSEL, 0, Length((cCur as TDBEditFC).Text));
if (cCur is TDBMemo) then PostMessage((cCur as TDBMemo).Handle, EM_SETSEL, 0, Length((cCur as TDBMemo).Text));
end;
VK_UP:
begin
DM_Mitumorisyo.tblMITUMEISAI.Prior;
if (cCur is TDBEdit) then PostMessage((cCur as TDBEdit).Handle, EM_SETSEL, 0, Length((cCur as TDBEdit).Text));
if (cCur is TDBEditFC) then PostMessage((cCur as TDBEditFC).Handle, EM_SETSEL, 0, Length((cCur as TDBEditFC).Text));
if (cCur is TDBMemo) then PostMessage((cCur as TDBMemo).Handle, EM_SETSEL, 0, Length((cCur as TDBMemo).Text));
end;
end;
end;
end;

Windowsのバージョン取得 Delphi

久々のDelphi関連です。

WindowsXP、IEで何かと話題のMicrosoft製品ですが、

OSのバージョンを取得して動作をコントロールする機会が多いので。


//******************************************************************************
// OS種類の取得
//******************************************************************************
function fncGetOSVer(pRetType: Integer): string;
var
osInfo : TOSVersionInfoEx;
sOsName : String;
sSpVer : String;
bRet : Boolean;

begin
osInfo.dwOSVersionInfoSize := sizeof(TOSVersionInfoEx);

bRet := GetVersionEx(osInfo);

sOsName :='';
sSpVer :='';

if bRet then begin

with osinfo do begin
case dwPlatformId of
VER_PLATFORM_WIN32_NT: //Windows NT/2000/XP
begin
if dwMajorVersion <= 4 then sOsName := 'WinNT4.0';
if dwMajorVersion = 5 then begin
if dwMinorVersion = 0 then begin
sOsName := 'Win2000';
if wServicePackMajor = 1 then begin
sSpVer := 'SP1';
end else if wServicePackMajor = 2 then begin
sSpVer := 'SP2';
end else if wServicePackMajor = 3 then begin
sSpVer := 'SP3';
end else if wServicePackMajor = 4 then begin
sSpVer := 'SP4';
end else begin
sSpVer := 'SPX';
end;
end;
if dwMinorVersion = 1 then begin
sOsName := 'WinXP';
if wServicePackMajor = 1 then begin
sSpVer := 'SP1';
end else if wServicePackMajor = 2 then begin
sSpVer := 'SP2';
end else if wServicePackMajor = 3 then begin
sSpVer := 'SP3';
end else begin
sSpVer := 'SPX';
end;
end;
if dwMinorVersion = 2 then begin
sOsName := 'Win2003';
if wServicePackMajor = 1 then begin
sSpVer := 'SP1';
end else if wServicePackMajor = 2 then begin
sSpVer := 'SP2';
end else begin
sSpVer := 'SPX';
end;
end;
end;
if dwMajorVersion = 6 then begin
if dwMinorVersion = 0 then begin // Win Vista, Win SV 2008
if wProductType = VER_NT_WORKSTATION then begin
sOsName := 'WinVISTA';
if wServicePackMajor = 1 then begin
sSpVer := 'SP1';
end else if wServicePackMajor = 2 then begin
sSpVer := 'SP2';
end else begin
sSpVer := 'SPX';
end;
end else begin
sOsName := 'Win2008';
end;
end;
if dwMinorVersion = 1 then begin // Win 7, Win SV 2008 R2
if wProductType = VER_NT_WORKSTATION then begin
sOsName := 'Win7';
if wServicePackMajor = 1 then begin
sSpVer := 'SP1';
end else begin
sSpVer := 'SPX';
end;
end else begin
sOsName := 'Win2008R2';
end;
end;
if dwMinorVersion = 2 then begin // Win 8, Win SV 2012
if wProductType = VER_NT_WORKSTATION then begin
sOsName := 'Win8';
end else begin
sOsName := 'Win2012';
end;
end;
if dwMinorVersion = 3 then begin // Win 8.1, Win SV 2012R2
if wProductType = VER_NT_WORKSTATION then begin
sOsName := 'Win8.1';
end else begin
sOsName := 'Win2012R2';
end;
end;
end;
end;

VER_PLATFORM_WIN32_WINDOWS: //Windows 9x/ME
begin
if dwMajorVersion =4 then begin
if (dwMinorVersion =0) then sOsName := 'Win95';
if (dwMinorVersion =10) then
begin
if szCSDVersion[1] = 'A' then
sOsName := 'Win98SE'
else
sOsName := 'Win98';
end;
if (dwMinorVersion =90) then sOsName := 'WinME';
end;
end;
end; //case
end; //with
end;

if pRetType = 0 then Result := sOsName;
if pRetType = 1 then Result := sSpVer;
end;


にほんブログ村のランキングに参加しています。
下記バナーをクリックしてくださると本当に助かります。
よろしくお願いいたします。
にほんブログ村 IT技術ブログへ
にほんブログ村


テーマ:プログラミング - ジャンル:コンピュータ

スポンサードリンク
最新記事
カテゴリ
カレンダー
09 | 2017/10 | 11
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31 - - - -
最新トラックバック
ブロとも申請フォーム

この人とブロともになる

月別アーカイブ
激安特価情報
Amazonタイムセール
楽天市場タイムセール
Yahoo出店記念セール
NTT-X Store 激安特価!
激安家電のGENO PLUS
コストコ・イケアの通販
つけたまま眠れるファンデ
家電品を安値で買うならこちら!
ケーズデンキ
ベルメゾンアウトレット
激安ブランドコスメ 週末セール
モバコレ SALE
au Brand Garden
アウトレットモール BRANDELI
ブックオフオンラインのオトナ買い
ビッグカメラ◆週末特別セール
ソフマップ 中古・アウトレット
【宿代全額ポイントバック】夏休み早期予約キャンペーン
ネットプライス 送料294円
イオンモールオンライン
EDIONネットショップ
最新コメント
天気予報

-天気予報コム- -FC2-
カウンター
検索フォーム
リンクに表示されるテキスト
ランキング参加中
クリックしていただけると、 こまつもとは大変嬉しいです。



人気ブログランキングへ

ランキングに参加しています。 クリックのご協力をお願い致します。 いつもありがとうございます。 にほんブログ村 通販ブログへ
ブログランキング・にほんブログ村へ
にほんブログ村 IT技術ブログ ソフトウェアへ
にほんブログ村 ゲームブログへ
にほんブログ村 IT技術ブログへ



人気ブログをblogramで分析

趣味・個人

ランキング

リンクリックブログランキング

私を登録 by BlogPeople



RSSリンクの表示
リンク
QRコード
QRコード
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。