팁모음집

Transcription

1 팁모음집 금주가몇번째주인지어떻게구합니까 function kcisleapyear( nyear: Integer ): Boolean; // 윤년을계산하는함수 Result := (nyear mod 4 = 0) and ((nyear mod 100 <> 0) or (nyear mod 400 = 0)); function kcmonthdays( nmonth, nyear: Integer ): Integer; // 한달에몇일이있는지를계산하는함수 const DaysPerMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); Result := DaysPerMonth[nMonth]; if (nmonth = 2) and kcisleapyear(nyear) then Inc(Result); function kcweekofyear( ddate: TDateTime ): Integer; // 위의두함수를써서몇번째주인지계산하는함수 X, ndaycount: Integer; nmonth, nday, nyear: Word; ndaycount := 0; decodedate( ddate, nyear, nmonth, nday ); For X := 1 to ( nmonth - 1 ) do ndaycount := ndaycount + kcmonthdays( X, nyear ); ndaycount := ndaycount + nday; Result := ( ( ndaycount div 7 ) + 1 ); 긴파일명사용하기 function filelongname(const afile: String): String; ainfo: TSHFileInfo;

2 if SHGetFileInfo(PChar(aFile),0,aInfo,Sizeof(aInfo),SHGFI_DISPLAYNAME)<>0 then Result:=StrPas(aInfo.szDisplayName) else Result:=aFile; 네트워크검색 connections or persistent (won't normally get here):} r:=wnetopenenum(listtype,resourcetype,resourceusage_container, nil,henum); { Couldn't enumerate through this container; just make a note of it and continue on: } if r<>no_error then AddShareString(TopContainerIndex,''); WNetCloseEnum(hEnum); Exit; { We got a valid enumeration handle; walk the resources: } while (1=1) do EntryCount:=1; NetResLen:=SizeOf(NetRes); r:=wnetenumresource(henum,entrycount,@netres,netreslen); case r of 0: { Yet another container to enumerate; call this function recursively to handle it: } if (NetRes[0].dwUsage=RESOURCEUSAGE_CONTAINER) or (NetRes[0].dwUsage=10) then DoEnumerationContainer(NetRes[0]) else case NetRes[0].dwDisplayType of { Top level type: } RESOURCEDISPLAYTYPE_GENERIC, RESOURCEDISPLAYTYPE_DOMAIN,

3 RESOURCEDISPLAYTYPE_SERVER: AddContainer(NetRes[0]); { Share: } RESOURCEDISPLAYTYPE_SHARE: AddShare(TopContainerIndex,NetRes[0]); ERROR_NO_MORE_ITEMS: Break; else MessageDlg('Error #'+IntToStr(r)+' Walking Resources.',mtError,[mbOK],0); Break; { Close enumeration handle: } WNetCloseEnum(hEnum); procedure TfrmMain.FormShow(Sender: TObject); DoEnumeration; // Add item to tree view; indicate that it is a container: procedure TfrmMain.AddContainer(NetRes: TNetResource); ItemName: String; ItemName:=Trim(String(NetRes.lpRemoteName)); if Trim(String(NetRes.lpComment))<>'' then if ItemName<>'' then ItemName:=ItemName+' '; ItemName:=ItemName+'('+String(NetRes.lpComment)+')'; tvresources.items.add(tvresources.selected,itemname);

4 // Add child item to container denoted as current top: procedure TfrmMain.AddShare(TopContainerIndex: Integer; NetRes:TNetResource); ItemName: String; ItemName:=Trim(String(NetRes.lpRemoteName)); if Trim(String(NetRes.lpComment))<>'' then if ItemName<>'' then ItemName:=ItemName+' '; ItemName:=ItemName+'('+String(NetRes.lpComment)+')'; tvresources.items.addchild(tvresources.items[topcontainerindex],itemname); { Add child item to container denoted as current top; this just adds a string for purposes such as being unable to enumerate a container. That is, the container's shares are not accessible to us.} procedure TfrmMain.AddShareString(TopContainerIndex: Integer;ItemName: String); tvresources.items.addchild(tvresources.items[topcontainerindex],itemname); { Add a connection to the tree view. Mostly used for persistent and currently connected resources to be displayed.} procedure TfrmMain.AddConnection(NetRes: TNetResource); ItemName: String; ItemName:=Trim(String(NetRes.lpLocalName)); if Trim(String(NetRes.lpRemoteName))<>'' then if ItemName<>'' then ItemName:=ItemName+' '; ItemName:=ItemName+'-> '+Trim(String(NetRes.lpRemoteName)); tvresources.items.add(tvresources.selected,itemname);

5 // Expand all containers in the tree view: procedure TfrmMain.mniExpandAllClick(Sender: TObject); tvresources.fullexpand; // Collapse all containers in the tree view: procedure TfrmMain.mniCollapseAllClick(Sender: TObject); tvresources.fullcollapse; // Allow saving of tree view to a file: procedure TfrmMain.mniSaveToFileClick(Sender: TObject); if dlgsave.execute then tvresources.savetofile(dlgsave.filename); // Allow loading of tree view from a file: procedure TfrmMain.mniLoadFromFileClick(Sender: TObject); if dlgopen.execute then tvresources.loadfromfile(dlgopen.filename); // Rebrowse: procedure TfrmMain.btnOKClick(Sender: TObject); DoEnumeration; end.

6 네트워크드라이브등록하기 procedure TStartForm.NetBtnClick(Sender: TObject); OldDrives: TStringList; i: Integer; OldDrives := TStringList.Create; OldDrives.Assign(Drivebox.Items); // Remember old drive list // Show the connection dialog if WNetConnectionDialog(Handle, RESOURCETYPE_DISK) = NO_ERROR then DriveBox.TextCase := tclowercase; // Refresh the drive list box for i := 0 to DriveBox.Items.Count - 1 do if Olddrives.IndexOf(Drivebox.Items[i]) = -1 then // Find new Drive letter DriveBox.ItemIndex := i; // Updates the drive list box to new drive letter DriveBox.Drive := DriveBox.Text[1]; // Cascades the update to connected directory lists, etc DriveBox.SetFocus; 다른윈도우에서선택된문자열복사하기 procedure TForm1.WMHotkey(Var msg: TWMHotkey); hotherwin, hfocuswin: THandle; OtherThreadID, ProcessID: DWORD; hotherwin := GetForegroundWindow; if hotherwin = 0 then Exit;

7 OtherThreadID := GetWindowThreadProcessID( ); if AttachThreadInput( GetCurrentThreadID, OtherThreadID, True ) then hfocuswin := GetFocus; if hfocuswin <> 0 then try SendMessage( hfocuswin, WM_COPY, 0, 0 ); finally AttachThreadInput( GetCurrentThreadID, OtherThreadID, False ); Memo1.Lines.Add( Clipboard.AsText ); if IsIconIC( Application.Handle ) then Application.Restore; 다른 Application 에 Data 전달하기 WM_COPYDATA- 다른 Application 에 Data 전달 unit other_ap; { 다른 Application 을찾아서 WM_COPYDATA 로 DATA 를전달 } interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; const WM_COPYDATA = $004A; type Tform1 = class(tform) Button1: TButton; Memo1: TMemo; procedure Button1Click(Sender: TObject); private { Private declarations }

8 procedure WMCopyData( m : TMessage); message WM_COPYDATA; public { Public declarations } form1: Tform1; implementation {$R *.DFM} type PCopyDataStruct = ^TCopyDataStruct; TCopyDataStruct = record dwdata: LongInt; cbdata: LongInt; lpdata: Pointer; type PRecToPass = ^TRecToPass; TRecToPass = packed record s : string[255]; i : integer; procedure TForm1.WMCopyData( m : TMessage); Memo1.Lines.Add(PRecToPass(PCopyDataStruct(m.LParam)^.lpData)^.s); Memo1.Lines.Add(IntToStr(PRecToPass(PCopyDataStruct(m.LParam)^.lpData)^.i)); procedure Tform1.Button1Click(Sender: TObject); h : THandle; cd : TCopyDataStruct; rec : TRecToPass;

9 if Form1.Caption = 'My App' then h := FindWindow(nil, 'My Other App'); rec.s := 'Hello World - From My App'; rec.i := 1; end else h := FindWindow(nil, 'My App'); rec.s := 'Hello World - From My Other App'; rec.i := 2; cd.dwdata := 0; cd.cbdata := sizeof(rec); cd.lpdata if h <> 0 then SendMessage(h, WM_CopyData, Form1.Handle, LongInt(@cd)); end. 델파이중복실행방지 unit PrevInst; interface uses WinTypes, WinProcs, SysUtils; type PHWND = ^HWND; function EnumFunc(Wnd:HWND; TargetWindow:PHWND): bool; export; procedure GotoPreviousInstance;

10 implementation function EnumFunc(Wnd:HWND; TargetWindow:PHWND): bool; ClassName : array[0..30] of char; Result := true; if GetWindowWord(Wnd,GWW_HINSTANCE) = hprevinst then GetClassName(Wnd,ClassName,30); if StrIComp(ClassName,'TApplication') = 0 then TargetWindow^ := Wnd; Result := false; procedure GotoPreviousInstance; PrevInstWnd : HWND; PrevInstWnd := 0; EnumWindows(@EnumFunc,longint(@PrevInstWnd)); if PrevInstWnd <> 0 then if IsIconic(PrevInstWnd) then ShowWindow(PrevInstWnd, SW_RESTORE) else BringWindowToTop(PrevInstWnd); end. 이 이러한유닛을프로젝트에추가하신후 DPR 소스의 BEGIN - END 를다음과같

11 수정해주세요 if hprevinst <> 0 then GotoPreviousInstance else Application.CreateForm(MyForm, MyForm); Application.Run; end. 델파이에서한글토글하기 델파이 2.0 이하에서는 ims.pas 를이용하여한영토글을구현했는데, 3.0 이상에서는한영토글에대한간단한답에있더군요. TEdit 에 ImsMode 프라퍼티를이용합니다. edit1.imemode:=imhangul; // 한글모드 edit2.imemode:=imalpha; // 영문모드 입력이한글이많을경우, 입력초기모드를한글모드로바꿔준다면, 사용자의한 / 영키를누르는것을없애줄수있겠지요. 델파이에서자동으로한글입력모드로변경시키는소스 uses 절에 Imm 을추가하세요 그런다음아래프로시저를작성하여 OnEnter 이벤트에서 한글을 on 하시구요 OnExit 이벤트에서 off 하세요 procedure TForm1.SetHangeulMode(SetHangeul: Boolean); tmode : HIMC;

12 tmode := ImmGetContext(handle); if SetHangeul then // 한글모드로 ImmSetConversionStatus(tMode, IME_CMODE_HANGEUL) IME_CMODE_HANGEUL, else // 영문모드로 ImmSetConversionStatus(tMode, IME_CMODE_ALPHANUMERIC, IME_CMODE_ALPHANUMERIC); 델파이에서폼을사정없이뜯어내는방법의소스 WindowRgn,HoleRgn : HRgn; WindowRgn := 0; GetWindowRgn(handle, WindowRgn); DeleteObject(WindowRgn); WindowRgn := CreateRectRgn(0,0,Width,Height); HoleRgn := CreateRectRgn(16,25,126,236); CombineRgn(WindowRgn, WindowRgn, HoleRgn, RGN_DIFF); SetWindowRgn(handle, WindowRgn, TRUE); DeleteObject(HoleRgn); 델파이에서의키값 아래에가상키값리스트입니다... vk_lbutton = $01; vk_rbutton = $02; vk_cancel = $03; vk_mbutton = $04; { NOT contiguous with L & RBUTTON } vk_back = $08; vk_tab = $09; vk_clear = $0C;

13 vk_return = $0D; vk_shift = $10; vk_control = $11; vk_menu = $12; vk_pause = $13; vk_capital = $14; vk_escape = $1B; vk_space = $20; vk_prior = $21; vk_next = $22; vk_end = $23; vk_home = $24; vk_left = $25; vk_up = $26; vk_right = $27; vk_down = $28; vk_select = $29; vk_print = $2A; vk_execute = $2B; vk_snapshot = $2C; { vk_copy = $2C not used by keyboards } vk_insert = $2D; vk_delete = $2E; vk_help = $2F; { vk_a thru vk_z are the same as their ASCII equivalents: 'A' thru 'Z' } { vk_0 thru vk_9 are the same as their ASCII equivalents: '0' thru '9' } vk_numpad0 = $60; vk_numpad1 = $61; vk_numpad2 = $62; vk_numpad3 = $63; vk_numpad4 = $64; vk_numpad5 = $65; vk_numpad6 = $66; vk_numpad7 = $67;

14 vk_numpad8 = $68; vk_numpad9 = $69; vk_multiply = $6A; vk_add = $6B; vk_separator = $6C; vk_subtract = $6D; vk_decimal = $6E; vk_divide = $6F; vk_f1 = $70; vk_f2 = $71; vk_f3 = $72; vk_f4 = $73; vk_f5 = $74; vk_f6 = $75; vk_f7 = $76; vk_f8 = $77; vk_f9 = $78; vk_f10 = $79; vk_f11 = $7A; vk_f12 = $7B; vk_f13 = $7C; vk_f14 = $7D; vk_f15 = $7E; vk_f16 = $7F; vk_f17 = $80; vk_f18 = $81; vk_f19 = $82; vk_f20 = $83; vk_f21 = $84; vk_f22 = $85; vk_f23 = $86; vk_f24 = $87; vk_numlock = $90; vk_scroll = $91;

15 디렉토리에관련된함수 function GetCurrentDir: string; // 현재의 Directory function ExtractFileDir(const FileName: string): string; // Directory 만 Return.Filename 빼고 function ExtractFileName(const FileName: string): string; // 화일이름만 Return 동작중인프로그램죽이기 unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, TlHelp32; type TForm1 = class(tform) ListBox1: TListBox; B_Search: TButton; B_Terminate: TButton; procedure B_SearchClick(Sender: TObject); procedure B_TerminateClick(Sender: TObject); private { Private declarations } public { Public declarations } Form1: TForm1; implementation {$R *.DFM}

16 // kernel32.dll 을사용하여현재떠있는 process 를읽어온다 procedure Process32List(Slist: TStrings); Process32: TProcessEntry32; SHandle: THandle; // the handle of the Windows object Next: BOOL; Process32.dwSize := SizeOf(TProcessEntry32); SHandle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0); if Process32First(SHandle, Process32) then // 실행화일명과 process object 저장 Slist.AddObject(Process32.szExeFile, TObject(Process32.th32ProcessID)); repeat Next := Process32Next(SHandle, Process32); if Next then Slist.AddObject(Process32.szExeFile, TObject(Process32.th32ProcessID)); until not Next; CloseHandle(SHandle); // closes an open object handle procedure TForm1.B_SearchClick(Sender: TObject); // 현재실행중인 process 를검색 ListBox1.Items.Clear; Process32List(ListBox1.Items); procedure TForm1.B_TerminateClick(Sender: TObject); hprocess: THandle; ProcId: DWORD; TermSucc: BOOL;

17 // 현재실행중인 process 를 kill if ListBox1.ItemIndex < 0 then System.Exit; ProcId := DWORD(ListBox1.Items.Objects[ListBox1.ItemIndex]); // 존재하는 process object 의 handle 을 return 한다 hprocess := OpenProcess(PROCESS_ALL_ACCESS, TRUE, ProcId); if hprocess = NULL then ShowMessage('OpenProcess error!'); // 명시한 process 를강제종료시킨다 TermSucc := TerminateProcess(hProcess, 0); if TermSucc = FALSE then ShowMessage('TerminateProcess error!') else ShowMessage(Format('Process# %x terminated successfully!', [ProcId])); end. 레지스트리를이용한모뎀찾기 WRegistry := TRegistry.Create; with Wregistry do rootkey := HKEY_LOCAL_MACHINE; if OpenKey ('\System\CurrentControlSet\Services\Class\Modem\0000',False) then Showmessage (' 모뎀이있습니다.');... free.. 마우스의 Enter/Exit Event 사용하기 TForm1 = class(tform) Image1 : TImage; private

18 m_orgproc : TWndMethod; procedure ImageProc ( Msg : TMessage ) ; public procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); : : procedure TForm1.FormCreate(Sender:TObject); m_orgproc := Image1.WindowProc; Image1.WindowProc := ImageProc; procedure TForm1.FormDestroy(Sender:TObject); Image1.WindowProc := m_orgproc; procedure TForm1.ImageProc( Msg : TMessage ); case Msg.Msg of CM_MOUSELEAVE: // 여기서콘트롤에마우스가들어왔을때를처리합니다. CM_MOUSEENTER: // 여기서콘트롤로부터마우스가벗어날때부분을처리합니다. m_orgproc(msg);

19 마우스의범위제한하기 다음예제는폼에 2 개의버튼을두고첫번째버튼을누르면마우스가폼밖으로못나가게 하고, 두번째버튼을누르면원래대로바꿔주는프로그램입니다... procedure TForm1.Button1Click(Sender: TObject); Rect : TRect; Rect := BoundsRect; InflateRect(Rect, 0, 0); ClipCursor(@Rect); procedure TForm1.Button2Click(Sender: TObject); ClipCursor(nil); Message 박스에두줄출력하기 MessageDlg(' 문자열 ' + chr(13) + ' 문자열 ', mtinformation,[mbok], 0); 참고 : 윈도우에서는 3 줄까지가능함. 3 줄이상의문자열은자동으로정렬하지 않으니개발자가주의해야함. 바탕화면바꾸기 GetMem( ThePChar, 255 ); StrPCopy( ThePChar, 'wallpaper.bmp'); SystemParametersInfo( SPI_SETDESKWALLPAPER, 0, ThePChar, SPIF_SENDWININICHANGE ); Freemem( ThePChar, 255 ); 브라우저동작하기

20 UrlMon 유닛으로선언되고있다 HlinkNavigateString Win32 API 을 ( 를 ) 씁니다. 호출예 : HlinkNavigateString(Nil,' 만약액티브폼의중 ( 안 ) 에서불러내고싶는경우에는이하와같이지정합니다 : HlinkNavigateString(ComObject,' ShellApi 유닛으로선언되고있다 ShellExecute 을 ( 를 ) 쓰는것도가능합니다. ShellExecute(0, 'open', ' nil, nil, SW_SHOW) 사용자가조합키를누른것처럼처리하는방법 다음소스를참고하기바랍니다. 중요한부분은조합키중키와키, 키와같이홀드 (hold) 상태인키를확인해서키값을포스팅해주는것입니다. 완전하다면더할나위없이좋겠지만, 그냥자신의프로그램에덧붙여사용하거나외부참조로사용해도무방할것입니다. procedure PostKeyEx( hwindow: HWnd; key: Word; Const shift: TShiftState; Specialkey: Boolean ); type TBuffers = Array [0..1] of TKeyboardState; pkeybuffers : ^TBuffers; lparam: LongInt; if IsWindow( hwindow ) then pkeybuffers := nil; lparam := MakeLong( 0, MapVirtualKey( key, 0 ) ); if Specialkey then

21 lparam := lparam or $ ; New( pkeybuffers ); try GetKeyboardState( pkeybuffers^[1] ); FillChar( pkeybuffers^[0],sizeof( TKeyboardState ), 0 ); if ssshift In shift then pkeybuffers^[0][vk_shift] := $80; if ssalt In shift then pkeybuffers^[0][vk_menu] := $80; lparam := lparam or $ ; if ssctrl in shift then pkeybuffers^[0][vk_control] := $80; if ssleft in shift then pkeybuffers^[0][vk_lbutton] := $80; If ssright in shift then pkeybuffers^[0][vk_rbutton] := $80; if ssmiddle in shift then pkeybuffers^[0][vk_mbutton] := $80; SetKeyboardState( pkeybuffers^[0] ); if ssalt in shift then PostMessage( hwindow, WM_SYSKEYDOWN, key, lparam); PostMessage( hwindow, WM_SYSKEYUP, key, lparam or $C ); end else PostMessage( hwindow, WM_KEYDOWN, key, lparam); PostMessage( hwindow, WM_KEYUP, key, lparam or $C ); Application.ProcessMessages;

22 SetKeyboardState( pkeybuffers^[1] ); finally if pkeybuffers <> nil then Dispose( pkeybuffers ); { PostKeyEx } procedure TForm1.SpeedButton2Click(Sender: TObject); Var W: HWnd; W := Memo1.Handle; PostKeyEx( W, VK_END, [ssctrl, ssshift], False ); // 전체선택 PostKeyEx( W, Ord('C'), [ssctrl], False ); // 클립보드로복사 PostKeyEx( W, Ord('C'), [ssshift], False ); // "C" 로치환 PostKeyEx( W, VK_RETURN, [], False ); // 엔터키 ( 새라인 ) PostKeyEx( W, VK_END, [], False ); // 라인의끝으로 PostKeyEx( W, Ord('V'), [ssctrl], False ); // 붙여넣기 시스템 About 사용하기 ShellAbout(Self.Handle, PChar(Application.Title), ' Application.Icon.Handle); Self.Handle 은현재동작중인 Application 의실행영역을리턴하는것이고... PChar( Application.Title ) 은 Title 의 Caption 을전달하는것..

23 ' 문서영역 ' 은이곳에서만들었다는표시... Application.Icon.Handle 은 About 에서보일 Icon 의값을전달하는방법 시스템 Image 를사용하는 TListView procedure TDirTreeView.FindAllSubDirectories(pNode: TCTreeNode; ItsTheFirstPass: Boolean); srch: TSearchRec; DOSerr: integer; NewText: String; NewPath: string; tnode: TCTreeNode; cnode: TCTreeNode; ImagesHandleNeeded : boolean; ccursor: HCursor; NewList: TStringList; i: integer; tpath: string; function TheImage(FileID: string; Flags: DWord; IconNeeded: Boolean): Integer; SHFileInfo: TSHFileInfo; Result := SHGetFileInfo(pchar(FileID), 0, SHFileInfo, SizeOf(SHFileInfo), Flags); if IconNeeded then Result := SHFileInfo.iIcon; function ItHasChildren(const fpath: string): Boolean; srch: TSearchrec; found: boolean; DOSerr: integer;

24 chdir(fpath); Found := false; DOSerr := FindFirst('*.*',faDirectory,srch); while (DOSerr=0) and not(found) do found := ((srch.attr and fadirectory)=fadirectory) and ((srch.name<>'.') and (srch.name<>'..')); if not(found) then DOSerr := FindNext(srch); sysutils.findclose(srch); chdir('..'); Result := Found; tnode := TopItem; ccursor := Screen.cursor; Screen.cursor := crhourglass; Items.BeginUpdate; SortType := stnone; tpath := uppercase(fcurrentpath); NewList := TStringList.Create; getdir(0,newpath); if (NewPath[length(NewPath)]<>'\') then NewPath := NewPath + '\'; ImagesHandleNeeded := ItsTheFirstPass; DOSerr := FindFirst('*.*',faDirectory,srch); while DOSerr=0 do if ((srch.attr and fadirectory)=fadirectory) and ((srch.name<>'.') and (srch.name<>'..')) then NewText := lowercase(srch.name);

25 NewText[1] := Upcase(NewText[1]); NewList.AddObject(NewText, pointer(newstr(newpath+newtext))); DOSerr := FindNext(srch); sysutils.findclose(srch); NewList.Sorted := true; with NewList do for i := 0 to Count-1 do cnode := Items.AddChildObject(pNode,Strings[i], PString(Objects[i])); with cnode do NewText := PString(Data)^; HasChildren := ItHasChildren(NewText); if ImagesHandleNeeded then Images.Handle := TheImage(NewText, SHGFI_SYSICONINDEX or SHGFI_SMALLICON, false); ImagesHandleNeeded := false; ImageIndex := TheImage(NewText, SHGFI_SYSICONINDEX or SHGFI_SMALLICON, true); SelectedIndex := TheImage(NewText, SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON, True); if AnsiCompareText(NewText,fCurrentPath)=0 then Expanded := true; StateIndex := SelectedIndex; Self.Selected := cnode; end else if (pos(uppercase(newtext),tpath)=1) then Expanded := true;

26 tnode := cnode; NewList.Free; Items.EndUpdate; if Assigned(tNode) then TopItem := tnode; Screen.cursor := ccursor; 실행하기 function fileexec(const acmdline: String; ahide, await: Boolean): Boolean; StartupInfo : TStartupInfo; ProcessInfo : TProcessInformation; {setup the startup information for the application } FillChar(StartupInfo, SizeOf(TStartupInfo), 0); with StartupInfo do cb:= SizeOf(TStartupInfo); dwflags:= STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK; if ahide then wshowwindow:= SW_HIDE else wshowwindow:= SW_SHOWNORMAL; Result := CreateProcess(nil,PChar(aCmdLine), nil, nil, False, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo); if await then if Result then WaitForInputIdle(ProcessInfo.hProcess, INFINITE); WaitForSingleObject(ProcessInfo.hProcess, INFINITE);

27 function fileredirectexec(const acmdline: String; Strings: TStrings): Boolean; StartupInfo : TStartupInfo; ProcessInfo : TProcessInformation; aoutput : Integer; afile : String; Strings.Clear; { Create temp. file for output } afile:=filetemp('.tmp'); aoutput:=filecreate(afile); try {setup the startup information for the application } FillChar(StartupInfo, SizeOf(TStartupInfo), 0); with StartupInfo do cb:= SizeOf(TStartupInfo); dwflags:= STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK or STARTF_USESTDHANDLES; wshowwindow:= SW_HIDE; hstdinput:= INVALID_HANDLE_VALUE; hstdoutput:= aoutput; hstderror:= INVALID_HANDLE_VALUE; Result := CreateProcess(nil,PChar(aCmdLine), nil, nil, False, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo); if Result then WaitForInputIdle(ProcessInfo.hProcess, INFINITE); WaitForSingleObject(ProcessInfo.hProcess, INFINITE); finally

28 FileClose(aOutput); Strings.LoadFromFile(aFile); DeleteFile(aFile); 외부 Application 의 Window 크기조절하기 SHOWWINDOW- 외부 Application 의 Window 크기조절 아래소스는현재 active 된 window 의 list 를구한후그중하나를선택하여 Minimized, Maximized 하는예제입니다. procedure GetAllWindowsProc(WinHandle: HWND; Slist: TStrings); P: array[0..256] of Char; {title bar 를저장할 buffer} P[0] := #0; GetWindowText(WinHandle, P, 255); {window's title bar 를알아낸다 } if (P[0] <> #0) then if IsWindowVisible(WinHandle) then {invisible 한 window 는제외 } Slist.AddObject(P, TObject(WinHandle)); {window 의 handle 저장 } procedure GetAllWindows(Slist: TStrings); WinHandle: HWND; Begin WinHandle := FindWindow(nil, nil); GetAllWindowsProc(WinHandle, Slist); while (WinHandle <> 0) do {Top level 의 window 부터순차적으로 handle 을구한다 } WinHandle := GetWindow(WinHandle, GW_HWNDNEXT); GetAllWindowsProc(WinHandle, Slist);

29 procedure TForm1.B_SearchClick(Sender: TObject); ListBox1.Items.Clear; GetAllWindows(ListBox1.Items); procedure TForm1.B_MaximizeClick(Sender: TObject); if ListBox1.ItemIndex < 0 then System.Exit; { 선택한 window 를 maximize} ShowWindow(HWND(ListBox1.Items.Objects[ListBox1.ItemIndex]), SW_MAXIMIZE); procedure TForm1.B_minimizeClick(Sender: TObject); if ListBox1.ItemIndex < 0 then System.Exit; { 선택한 window 를 minimize} ShowWindow(HWND(ListBox1.Items.Objects[ListBox1.ItemIndex]), SW_MINIMIZE); 워크그룹의호스트네임읽어내기 program ShowSelf; {$apptype console} uses Windows, Winsock, SysUtils; function HostIPFromHostEnt( const HostEnt: PHostEnt ): String; Assert( HostEnt <> nil ); // first four bytes are the host address Result := Format( '%d.%d.%d.%d', [Byte(HostEnt^.h_addr^[0]), Byte(HostEnt^.h_addr^[1]), Byte(HostEnt^.h_addr^[2]), Byte(HostEnt^.h_addr^[3])] );

30 r: Integer; WSAData: TWSAData; HostName: array[0..255] of Char; HostEnt: PHostEnt; // initialize winsock r := WSAStartup( MakeLong( 1, 1 ), WSAData ); if r <> 0 then RaiseLastWin32Error; try Writeln( 'Initialized winsock successfully...' ); // get the host name (this is the current machine) FillChar( HostName, sizeof(hostname), #0 ); r := gethostname( HostName, sizeof(hostname) ); if r <> 0 then RaiseLastWin32Error; Writeln( 'Host name is ', HostName ); // get host entry (address is contained within) HostEnt := gethostbyname( HostName ); if not Assigned(HostEnt) then RaiseLastWin32Error; Writeln( 'Got host info...' ); // dump out the host ip address Writeln( 'Host address: ', HostIPFromHostEnt( HostEnt ) ); finally WSACleanup; end. 윈도우시작메뉴히스트로에문서등록하기

31 윈도우즈시작메뉴에있는문서히스토리에자기가생성한 화일을등록할수있는함수가있습니다. 먼저다음과같은프로시져를프로그램에넣어주세요. use ShellAPI, ShlObj; procedure AddToStartDocument(FilePath: string) SHAddToRecentDocs(SHARD_PATH, PChar(FilePath)); 자이제이함수를사용해봅시다. 우린파라미터로문서의경로를넘겨주면됩니다. 예 ) AddToStartDocument(C:\Test.txt); => 책에이렇게나와있는데, 미스프린팅같군요. -> 요렇게해주세요. AddToStartDocument('C:\Test.txt'); 윈도우배경그림바꾸기 Window 배경그림바꾸기 procedure ChangeIt; Reg: TRegIniFile; Reg := TRegIniFile.Create('Control Panel'); Reg.WriteString('desktop','Wallpaper','c:\windows\kim.bmp'); Reg.WriteString('desktop', 'TileWallpaper', '1'); Reg.Free; SystemParametersInfo(SPI_SETDESKWALLPAPER,0,nil,SPIF_SENDWININICHANGE);

32 Status 에색깔넣기 Status bar 에색깔넣기 StatusBar Font 의색을바꾸는방법은직접그려주는수밖에없습니다. 익히아시겠지만 StatusBar 의 Item 이라할수있는 TStatusPanel 에는 Style 이란게있습니다. 이값은 pstext 나 psownerdraw 란값을갖는데 psownerdraw 일때에는해당 Panel 을그릴때마다 OnDrawPanel event 가호출됩니다. 이때에원하는색으로직접그려주시면됩니다. psownerdraw 일때는그려주지않게되면 Text 값을갖고있다하더라도전혀나오질않으므로, 반드시위에말한 event 에서그려주셔야합니다. 다음에예제를보여드립니다. procedure TfmMain.m_statusBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect); with StatusBar.Canvas do case Panel.ID of 0 : Font.Color := clblue; 2 : if Panel.Text = ' 한글 ' then Font.Color := clred else Font.Color := clblue; FillRect(Rect); TextOut(Rect.Left+2,Rect.Top+2,Panel.Text); 위에 ID 란 property 를사용했는데요, 이것은 index 와는약간차이가있습니다. index propery 와같이부여되긴하지만, item 이추가, 삭제, 삽입되더라도 ID 의값은변하질않습니다. 다시말해한번부여된 ID 는다시사용되지않습니다. TreeView 프린트하기 TreeView and Print paintto can be made to work, you just have to scale the printer.canvas in the ratio of screen to printer resolution.

33 procedure TForm1.Button2Click(Sender: TObject); Printer.BeginDoc; try printer.canvas.moveto(100,100); SetMapMode( printer.canvas.handle, MM_ANISOTROPIC ); SetWindowExtEx(printer.canvas.handle, GetDeviceCaps(canvas.handle, LOGPIXELSX), GetDeviceCaps(canvas.handle, LOGPIXELSY), Nil); SetViewportExtEx(printer.canvas.handle, GetDeviceCaps(printer.canvas.handle, LOGPIXELSX), GetDeviceCaps(printer.canvas.handle, LOGPIXELSY), Nil); treeview1.paintto( printer.canvas.handle, 100, 100 ); finally printer.enddoc;