파란크리스마스

출처 : http://www.xxlinux.com/linux/dev/Delphi/2007-10-30/11392.html
http://dolba.net/old_k2club/bbs/bbs.php3?board=delphi&mode=view&id=345&page=32&recnum=359&keyword=&flag=
http://www.pic16.com/BBS/dispbbs.asp?boardID=31&ID=17357&page=3

function StrToBin(const S: string): string;
const
  BitArray: array[0..15] of string =
      ('0000', '0001', '0010', '0011',
       '0100', '0101', '0110', '0111',
       '1000', '1001', '1010', '1011',
       '1100', '1101', '1110', '1111');
var
  Index: Integer;
  LoBits: Byte;
  HiBits: Byte;
begin
  Result := '';
  for Index := 1 to Length(S) do
  begin
      HiBits := (Byte( S[Index]) and $F0) shr 4;
      LoBits := Byte( S[Index]) and $0F;
      Result := Result + BitArray[HiBits];
      Result := Result + BitArray[LoBits];
  end;
end;

function StringToHex(const S: string): string;
var
  Index: Integer;
begin
  Result := '';
  for Index := 1 to Length(S) do
    Result := Result + IntToHex( Byte( S[Index] ), 2 );
end;

function TransChar(AChar: Char): Integer;
begin
  if AChar in ['0'..'9'] then
  Result := Ord(AChar) - Ord('0')
  else
  Result := 10 + Ord(AChar) - Ord('A');
end;

function HexToString(aHex: String): String;
var
  I : Integer;
  CharValue: Word;
begin
  Result := '';
  for I := 1 to Trunc(Length(aHex)/2) do begin
    Result := Result + ' ';
    CharValue := TransChar(aHex[2*I-1])*16 + TransChar(aHex[2*I]);
    Result[I] := Char(CharValue);
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  ShowMessage(
    '한글'' Hex Code is ' + StringToHex('한글') + chr(13) +
    '한글'' Binary Code is ' + StrToBin('한글') + chr(13) +
    '한글'' HexToString ' + HexToString(StringToHex('한글'))
  );
end;

출처 : http://delphi.about.com/cs/adptips2002/a/bltip1002_5.htm

type
  TByteArr = array of byte;

function StringToBytes(aString: String): TByteArr;
var
  i: integer;
begin
  SetLength( Result, Length(aString)) ;
  for i := 0 to Length(aString) - 1 do
    Result[i] := ord(aString[i + 1]) { - 48} ;
end;

function BytesToString(aBytes : TByteArr): String;
begin
  Result := PChar(aBytes);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  buffer : TByteArr;
begin
  buffer := StringToByte(Edit1.Text);
  ShowMessage(ByteToString(buffer));
end;

Constants

출처 :

http://delphi.about.com/od/beginners/l/blrtldatetime.htm
http://wwwi.tistory.com/category/델파이
http://www.zetblog.net/Zcontent_list.php?category_idx=61

CompareDate

uses
  DateUtils;

//# 같으면 0 출력
ShowMessage(IntToStr(CompareDate(StrToDate('2007-04-01'), StrToDate('2007-04-01'))));
//# 오른쪽이 더 크면 -1 출력
ShowMessage(IntToStr(CompareDate(StrToDate('2007-04-01'), StrToDate('2007-04-02'))));
//# 왼쪽이 더 크면 1 출력
ShowMessage(IntToStr(CompareDate(StrToDate('2007-04-02'), StrToDate('2007-04-01'))));

출처 : http://www.swissdelphicenter.ch/torry/showcode.php?id=147

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    id1 : Integer;
    procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
 if Msg.HotKey = id1 then
   ShowMessage('Ctrl + A 선택!');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // 키 등록 Ctrl + A 
  id1 := GlobalAddAtom('Hotkey1');
  RegisterHotKey(Self.Handle, id1, MOD_CONTROL, $41); // $41 -> A
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // 키 해제
  UnRegisterHotKey(Handle, id1);
  GlobalDeleteAtom(id1);
end;

end.

출처
http://kurapa.com/content-a411_%25ED%2588%25AC%25EB%25AA%2585%25EC%259C%2588%25EB%258F%2584%25EC%259A%25B0
http://careerblog.scout.co.kr/home/?pSeq=665762&blogURL=http://neodreamer.tistory.com/39
http://careerblog.scout.co.kr/search/?searchtype=4&searchtext=CodeGear

// 투명 윈도우 만들기
procedure TfmMain.Button1Click(Sender: TObject);
begin
  SetWindowLong(handle, GWL_EXSTYLE, GetWindowLong(handle, GWL_EXSTYLE) or WS_EX_LAYERED);
  SetLayeredWindowAttributes(handle, 0, Round((255 * 70 ) / 100), LWA_ALPHA);
end;

// 투명 윈도우 만들기 + 최상위 윈도우 + 이벤트 활성화
procedure TfmMain.Button2Click(Sender: TObject);
begin
   Self.Color := RGB(1, 1, 1);
   SetWindowLong(handle, GWL_EXSTYLE, GetWindowLong(handle, GWL_EXSTYLE) or WS_EX_LAYERED);
   SetLayeredWindowAttributes( handle, RGB(1, 1, 1), 127, LWA_COLORKEY or LWA_ALPHA);
  Self.FormStyle := fsStayOnTop;
end;

Delphi Tip - File Download

출처 : http://delphi.about.com/od/internetintranet/a/get_file_net.htm

uses WinInet;

function GetInetFile (const fileURL, FileName: String): boolean;
const
  BufferSize = 1024;
var
  hSession, hURL: HInternet;
  Buffer: array[1..BufferSize] of Byte;
  BufferLen: DWORD;
  f: File;
  sAppName: string;
begin
  result := false;
  sAppName := ExtractFileName(Application.ExeName);
  hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) ;
  try
    hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0) ;
    try
      AssignFile(f, FileName);
      Rewrite(f,1) ;
      repeat
        InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen);
        BlockWrite(f, Buffer, BufferLen);
      until BufferLen = 0;
      CloseFile(f) ;
      result := True;
    finally
      InternetCloseHandle(hURL);
    end
  finally
    InternetCloseHandle(hSession);
  end;
end;

// 윈도우즈의 임시폴더 명을 반환한다.
function SysTempPath(): String;
var
  Buffer: array[0..1023] of Char;
begin
  SetString(Result, Buffer, GetTempPath(Sizeof(Buffer)-1, Buffer));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  internetFile,
  localFileName: string;
begin
 internetFile := 'http://localhost:8080/Sample.jmd';
 localFileName := SysTempPath() + 'test.xml';

 if GetInetFile(internetFile, localFileName) then
   ShowMessage(SysTempPath() + 'Sample.jmd' + ' / Download successful.')
 else
   ShowMessage('Error in file download.') ;
end;