'API'에 해당되는 글 1건
- 2014.02.13 델파이 API
■윈도우API
●System Modal 폼을 만들려면?
윈도우 API 함수인 SetSysModalWindow를 사용하면 가능하다.
다은 System Modal 창을 보여주는 간단한 예제이다.
procedure TMainForm1.Create(Application) do
begin
SetSysModalWindow(Handle);
end;
●.RES 파일에서 비트맵을 불러 오려면?
다음과 같이 선언한다.
implementation
{$R C:DelphiMydirMyRes.Res} <- .RES 파일이 있는 경로명과 파일명
위와 같이 선언한 후에 사용시에는 다음과 같이 윈도우 API 함수를 이용한다.
Image1.Picture.Bitmap.Handle := LoadBitmap(HInstance, 'BITMAP1');
●Win95와 W3.X를 구별하는 법은?
윈도우 API 함수인 GetVersion을 쓰면 가능하다.
다음은 버튼을 누르면 윈도우의 버전을 보여준다.
procedure TForm1.Button1Click(Sender : TObject);
var
x : Lonhint;
y,z : integer;
begin
x := GetVersion;
y := integer(x and $ff);
z := integer(x shr 8) and $ff);
Edit1.Text := IntToStr(y);
Edit2.Text := IntToStr(z);
end;
●마우스 커서를 보이지 않게 하려면?
윈도우 API 함수인 ShowCursor에서 값을 False 로 준다.
●정의된 Message Handler에 다른 작업을 추가하려면?
예를 들어, CM_DIALOGKEY Message가 발생되었을 때 원하는 작업을 추가하려고 한다면 Public Section에 다음과 같이 선언한다.
procedure CMDialogKey(var Message : TCMDialogKey);message DM_DIALOGKEY;
procedure 이름을 Message 이름에서 _(밑줄) 표시를 뺀다. Procedure 의 정의는 다음과 같다.
procedure TForm1.CMDialogKey(var Message : TCMDialogKey);
begin
if CharCode = VK_TAB then begin
{Process the Alt+Tab key here}
result := 1;
exit;
end;
inherited;
end;
Result를 1로 Setting하면 더 이상 실행시키지 않고 중단시키겠다는 뜻이고, inherited 문은 Parent Handler 로 제어를 보냄을 의미한다.
모든 작업을 일일이 처리하지 않으려면 inherited 문을 사용하기 바란다.
●런타임시에 DLL을 Load하고 Free시키는 방법은?
if H<32 then begin
ShowMessage('No DLL');
exit;
end;
DicProc := TDisProc(GetProcAddress(H, 'displayTable'));
edit1.Text := DisProc;
FreeLibrary(H);
end;
●비정상적으로 종료된 DLL 프로그램을 강제적으로 Unload하는 방법은?
윈도우 API 함수인 GetModuleHandle 은 DLL의 Handle을 돌려주므로 ModuleHandle 이 0을 리턴할 때까지 Freelibrary를 Call한다.
만약 DLL이 다른 DLL을 Load했다면 Child DLL을 먼저 Free 시킨다.
●DLL의 Data Segment를 Fixed에서 Movable로 바꾸는 방법은?
DLL 외부에서 GlobalPageUnlock(DESG)를 부르면 된다. 이 함수는 DLL 소스에서 Pointer 등을 이용하지 않는다면 정상적으로 실행될 것이다.
●Title Bar가 없는 Form을 움직이게 하려면?
폼 위에서 마우스 커서가 움직이면, 윈도우는 폼에 WM_NCHitTest 메시지를 보낸다. 이때 폼은 마우스가 폼의 어느 위치에 있는지를 메시지로 주게 된다. 마우스의 버튼을 누르는 것과 같은 Event가 발생하면 윈도우는 이 정보를 써서 특정 행동을 수행하게 되는 것이다.
다음은 WM_NCHitTest 메시지가 특정한 값을 주는 예제 코드이다.
procedure TNoCapForm.WMNCHitTest(var Msg : TMessage);
begin
if GetAsynKeyState(VK_LBUTTON) < 0 then
Msg.Result := HTCAPTION
else
Msg.Result := HTCLIENT;
end;
●Resource를 동적으로 Load/Free하는 방법은?
윈도우가 제공하는 LoadResource(), FreeResource() API 함수를 사용한다.
●Visual Basic의 doEvent 와 같은 기능을 사용하려면?
다음과 같이 함수를 만들 수 잇다.
function doEvents : Boolean;
var
msg : TMsg;
begin
while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
begin
if msg.message = WM_QUIT then
begin
PostQuitMessage(msg.wParam);
doEvents := true;
exit;
end
else
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end;
doEvents := false;
end;
●프로그램의 실행이 끝나기를 기다리는 법은?
윈도우 함수는 핸들을 돌려주므로 이것을 이용한다.
procedure SomeProc;
var
ProgramHandle : THandle;
begin
ProgramHandle := WinExec('C:Program.exe', SW_SHOWNORMAL);
{프로그램이 종료될 때까지 반복}
while GetMoudleusage(ProgramHandle) <> 0 do Application.ProcessMessages;
end;
●프로그램 실행중에 잠시 멈추고 다른 프로세스를 실행하려면?
다음과 같은 코드를 작성할 수 있다.
procedure TForm1.Delay(msecs : integer);
var
FirstTickCount : longint;
begin
FirstTickCount := GetTickCount;
repeat
{실행을 잠시 중단하고 다른 프로세스를 실행한다.}
Application.ProcessMessages;
until ((GetTickCount-FirstTickCount) >= LongInt(msecs));
end;
참고로 Application.ProcessMessages는 메시지 큐에 쌓여 있는 메시지 중 하나를 처리하고 메시지가 큐에 없으면 False를 리턴한다.
●Control의 Handle 이나 ID를 얻는 방법은?
Control Object의 Pointer를 알고 있다면 PointerToMyControl^.HWindow가 바로 윈도우 핸들이다.
만약, Control 의 Handle을 알고 있다면 GetDlgCtrlID() API 함수는 ID를 돌려준다.
ControlID := GetDlgCtrlID(ControlHandle);
만약 Control의 Pointer를 모르고 ID만 알고 있다면, GetDlgItem() API 함수는 Handle을 돌려준다.
ControlHandle := GetDlgItem(DialogHandle, COntrolID);
●프로그램이 실행된 디렉토리를 알 수 있는 방법은?
다음의 함수는 Application 이라는 개체의 ExeName 속성으로부터 디렉토리 경로를 추출해낸다.
function GetExePath : String;
var
LastBackSlashPos, Index : Integer;
begin
Result := Application.ExeName;
for Index := 1 to length(Result) do
if REsult[Index] = '' then LastBackSlashPos := Index;
{'' 기호가 붙지 않도록 하려면 LastBackSlashPos에서 1을 빼야 한다}
Result[0] := chr(LastBackSlashPos - 1);
end;
●Directory를 만드는 방법은?
MKDIR Procedure를 이용하면 된다.
MkDir('C:DelphiMyDir');
●MediaPlayer를 이용하지 않고 Sound를 발생할 수 있는 방법은?
mmSystem에 있는 SndPlaySound Function을 이용하면 된다.
SndPlaySound('C:Windowsding.WAV', snd_Async);
●윈도우의 Message를 처리하는 방법은?
다음 윈도우 메시지를 처리하는 Procedure를 참고하기 바란다.
procedure YieldToOthers;
var
MSG : TMSG;
begin
while PeekMessage(MSG, 0, 0, 0, PM_REMOVE) do begin
if Msg.Message = WM_QUIT then exit;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
●윈도우의 Main Message Procedure를 만드는 방법은?
다음 예제 Procedure를 참고하기 바란다.
procedure TForm1.ClientWndProc(var Message : TMessage);
begin
with Message do
case Msg of
WM_MOUSEMOVE : Memo1.Lines.Add('Mouse Move');
WM_LBUTTONDOWN : Memo1.Lines.Add('LeftButton down');
else
Result := CallWindowProc(FPrevClientProc, Handle, Msg, wParam, lParam);
end;
end;
●다른 응용프로그램의 메뉴 기능을 실행하려면?
다음 예제 Procedure를 참고하기 바란다.
CurrWnd := GetWindow(Application.Handle, gw_hwndfirst);
length := GetWindowText(Currwnd, tmpstr, 255);
if length > 0 then
begin
if(pos('훈민정음‘, strpas(tmpstr)) > 0) and (strpas(pAttach^.filepath.tmpstr) <> nil) then
CurrWnd := 0;
end;
tmpname := ExtractFilename(strpas(pAttach^.filepath));
while CurrWnd <> 0 do
begin
length := GetWindowText(CurrWnd, tmpstr, 255);
if (length > 0) and (pos('훈민정음‘, strpas(tmpstr) > 0) and (pos(tmpname,
StrPas(tmpstr)) > 0) then
break;
CurrWnd := GetWindow(CurrWnd, GW_HWNDNEXT);
Application.ProcessMessages;
end;
Handle := CurrWnd;
if Handle <> 0 then
begin
SendMessage(Handle, WM_COMMAND, 4005, 0);
SendMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, 0);
end;
●폼이 최소화되지 못하게 하려면?
다음과 같이 WM_SYSCOMMAND 메시지를 처리하면 된다.
type
TForm1 = class(TForm)
public :
procedure WMSysCommand(var Msg : TWMSysCommand);message
WM_SYSCOMMAND;
end;
procedure TForm1.WMSysCommand(var Msg : TWMSysCommand);
begin
{최소화/최대화 버튼을 누를 때 아무 작용을 하지 않게 한다}
if (Msg.CmdType = SC_MINIMIZE) or (Msg.CmdType = SC_MAXMIZE) then
Msg.CmdType := SC_RESTORE;
DefaultHandler(Msg);
end;
●DPR 파일의 Application.Run이 실행되기 전에 Window 메시지를 가로채는 방법은?
다음과 같이 새로운 Windows Message Procedure를 정의하고, 그것을 Main Windows Procedure 로 설정한다.
다음 예제 Procedure를 참고하기 바란다.
program Project1;
uses
Forms, messages, wintypes, winprocs,
Unit1 in 'UNIT1.PAS';
{$R *.RES}
var
OldWndProc : TFarProc;
function NewWndProc(hWndAppl : HWnd; Msg, wParam : Word; lParam : Longint):
Longint; export;
begin
result := 0; {Default WndProc return value}
{message 처리 루틴이 들어갈 곳}
result := CallWindowProc(OldWndProc, hWndAppl, Msg, wParam, lParam);
end;
begin
Application.CreateForm(TForm1, Form1);
OldWndProc := TFarProc(GetWindowLong(Application.Handle, GWL_WNDPROC));
SetWindowLong(Application.Handle, GWL_WNDPROC, longint(@NewWndProc));
Application.Run;
end.
●Task Handling 방법은?
ToolHelp unit 에 저으이되어 있는 함수들을 이용하면 된다.
다음은 TaskFirst, TaskNext 등을 이용한 예제이다.
function isTaskInstance(HInst : Longint) : Boolean;
var
CurrentTask : TTaskEntry;
Success : boolean;
begin
Result := false;
Yield;
CurrentTask.dwSize := SizeOf(CurrentTask);
Success := TaskFirst(@CurrentTask);
while success do begin
if CurrentTask.HInst = HInst then begin
Result := true;
exit;
end;
Success := TaskNext(@CurrentTask);
end;
end;
●Virtual Key Code List는 어디서 찾나?
Windows.pas에 있다.
●현재 원하는 프로그램이 실행중인지를 찾는 방법은?
Findwindow를 사용하기 바란다.
procedure TForm1.Button1Click(Sender : TObject);
var
Apppath : string;
Fhandle : HWND;
begin
Apppath := ExtractFilepath(Application.exename);
WinExec(Pchar(Apppath+'project1.exe'),SW_SHOW)
Application.ProcessMessage;
while FHandle = 0 do
Fhandle := FindWindow('Tapplication', 'project1');
end;
●DLL 사용법
1.C에서 작성한 DLL을 델파이에서 사용시
C에서 DLL 만들 때
_declspec(dllexport) int fixtags(char *filename, short level, char* tag_prfix)
{
}
Delphi에서 사용.
Interface
function fixtags(filename : PChar; level : Smallint; tagprefix : Pchar): integer;FAR
;CDECL;
implementation
function fixtags(filename : PChar; level : Smallint; tagprefix : Pchar): integer; external
'dllfix.dll' name 'fixtags';
2.델파이에서 작성한 DLL을 델파이에서 사용시
implementation
function GetPassword(Apassword : Pchar): WordBool; far; external PASSWORD.dll';
●윈도우 메시지로 Edit의 Text Handling 하려면?
procedure TForm1.Button1Click(Sender : TObject);
var
p : pChar;
I : integer;
begin
I := edit1.perform(wm_GetTextLength, 0, 0) + 1;
p := AllocMem(i);
edit1.perform(wm_GetText, I, longint(p));
edit2.perform(wm_SetText, 0, longint(p));
FreeMem(p, I);
end;
●Cursor를 Load하려면?
delphiimagescursors 안에 있는 CURSOR를 사용한다.
Image Editor를 상ㅇ하여 Res File로 Load 한다.
{$R programsdelphiMyFile.res}
const Cursorx = 1; {임시 숫자}
procedure stuff;
begin
Screen.cursors[Cursorx] := LoadCursor(hInstance, pchar('cursor_1'));
Screen.cursors := PutitHere;
end;
●Mouse 위치를 제조정하려면?
procedure PlaceMouse(x,y : word);
var
tp : TPoint;
begin
tp := ClientToScreen(point(x, y));
SetCursorPos(tp.x, tp.y);
end;
●Application을 Program Manager/Start Menu에 추가하려면?
1.TDDEClientConv Component를 Form 에 추가한다.
2.다음의 코드를 추가한다.
var
Macro : String;
Command : Array[0..255] of Char;
begin
{link를 연다.}
DDEClient.OpenLink;
{group을 생성}
Macro := Format('[CreateGroup(%s)]', ['<your group name>']) + #13#10;
StrPcopy(Command, Macro);
if not DDEClient.ExecuteMacro(Command, False) then
MessageDlg('<your error message>', mtError, [mbok], 0);
{application을 추가}
Macro := '[AddItem('+<your application>+', '+<your description>+')]' + #13#10;
StrPcopy(Command, Macro);
if not DDEClient.ExecuteMacro(Command, False) then
MessageDlg('your error message>', mtError, [mbok], 0);
{새로운 group를 보여줌}
StrPCopy(Command, '[ShowGroup(NonExist, 1)]');
DDEClient.ExecuteMacro(Command, False);
{link를 닫음}
DDEClient.OpenLink;
end;
●Text를 Rotate 하려면?
procedure TextRotate(LocalCanvas : TCanvas; Text : String; X : Integer; Y : Integer;
RotateAngle : Integer);
var
Logfont : TLogFont;
begin
{font 정보를 구함}
GetObject(LocalCanvas.Handle, Sizeof(TLogFont), LogFont);
LogFont.lfEscapement := RotateAngle * 10;
{새로운 rotated font handle을 할당}
LocalCanvas.Font.Handle := CreateFontIndirect(LogFont);
{print text}
LocalCanvas.TextOut(X, Y, Text);
end;
●on_click Event를 발생하지 않고 ComboBox를 체크하려면?
procedure CheckNoClick(CB : TCheckBox; CheckIt : Boolean);
begin
CB.Perform(BM_SETCHECK, Ord(CheckIt), 0);
end;
<CheckNoClick 프로시저 호출하는 방법>
CheckNoClick(ComboBox1, True);
●프로그램상에서 Network Drive를 연결하려면?
procedure TForm1.Button1Click(Sender : TObject);
var
NRW : TNetResource;
begin
with NRW do
begin
dwType := RESOURCETYPE_ANY;
lpLocalName := 'X:'; //map to this driver letter
lpRemoteName := '\ MyServerMyDirectory';
// Must be filled in. if an empty string is used,
// it will use the lpRemoteName.
lpProvider := '';
end;
WNetAddConnection2(NRW, 'MyPassword', 'MyUserName',
CONNECT_UPDATE_PROFILE);
end;
●PORT를 인식하려면?
<읽기>
function GetPort() : Byte;
var
InValue : Byte;
Address : Word;
begin
asm
mov DX, Address
in AL,DX
mov InValue, AL
end;
GetPort := InValue;
end;
<쓰기>
procedure SetPort(OutValue : Byte);
var
Address : Word;
begin
Address : Word;
begin
asm
mov DX,Address
mov AL, OutValue
out DX, AL
end;
end;
●그래픽으로 프린트하는 대신에 TPrinter에게 프린터에 내장된 기본 글꼴을 사용하도록 하려면?
윈도우 API 함수인 GetStockObject() 함수를 사용해서 디바이스 디폴트 글꼴 핸들을 얻고, Printer.Font.Handle 에 대입하면 된다.
uses Printers;
procedure TForm1.Button1Click(Sender : TObject);
var
tm : TTextMetric;
I : integer;
begin
if PrintDialog1.Execute then begin
Printer.BeginDoc;
Printer.Canvas.Font.Handle := GetStockObject(DEVICE_DEFAULT_FONT);
GetTextMetrics(Printer.Canvas.Handle, tm);
for I := 1 to 10 do begin
Printer.Canvas.TextOut(100, i*tmHeight + tm.tmExternalLeading, 'Test');
end;
Printer.EndDoc;
end;
end;
●윈도우 95의 시작 버튼의 문서 메뉴에 문서를 추가하려면?
Shell 함수인 SHAddToRecentDocs를 사용한다.
uses ShlOBJ;
procedure TForm1.Button1Click(Sender : TObject);
var
s : string;
begin
s := 'C:DownLoadntkfaq.html';
SHAddToRecentDocs(SHARD_PATH, pChar(s));
end;
●응용프로그램에 할당된 CPU 시간을 변경하려면?
다음 예제는 응용프로그램에 주어지는 CPU 우선순위를 변경하는 것이다. 이 우선 순위를 변경할 때에는 너무 높은 값을 주지 않도록 한다.
추가 정보는 Win32 도움말 중에서 SetThreadPriority() 함수를 참조하기 바란다.
procedure TForm1.Button1Click(Sender : TObject);
var
ProcessID : DWORD;
ProcessHandle : THandle;
ThreadHandle : THandle;
begin
ProcessID := GetCurrentProcessID;
ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION, false, ProcessID);
SetPriorityClass(ProcessHandle, REALTIME_PRIORITY_CLASS);
ThreadHandle := GetCurrentThread;
SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL);
end;
●문자열의 배경색을 변경하려면?
API 함수인 SetBkColor() 과 TextOut()을 사용한다.
procedure TForm1.Button1Click(Sender : TObject);
var
OldTextColor : TColorRef;
OldBkColor : TColorRef;
OldBkMode : Integer;
begin
OldTextColor := SetTextColor(Form1.Canvas.Handle, RGB(0,0,255));
OldBkColor := SetBkColor(Form1.Canvas.Handle, RGB(255,0,0));
OldBkMode := SetBkMode(Form1.Canvas.Handle, OPAQUE);
TextOut(Form1.Canvas.Handle, 100, 100, 'Blue text on red Background', 27);
SetBkMode(Form1.Canvas.Handle, OldBkMode);
SetBkColor(Form1.Canvas.Handle, OldBkColor);
SetTextColor(Form1.Canvas.Handle, OldTextColor);
end;
●코드에서 Display 모드 설정을 변경하려면?
윈도우 API 함수인 EnumDisplaySettings()을 사용하여 설정되어 있는 모드 설정에 대한 리스트를 얻을 수 있고, ChangeDisplaySettings()는 디스플레리 설정을 변경 하기 위해서 사용될 수 있다. 그러나 많은 드라이버들은 변경사항이 가능하도록 설정했어도, 컴퓨터를 재부팅하지 않고 재설정을 수행할 수 없다.
unit Unit1;
interface
uses
Windows, Messages, Sysutils, Classes, Graphics, Control, Forms,
Dialogs, StdCtrls, Spin;
type
PdmArray = ^TDmArray;
TDmArray = array[0..] of TDeviceMode;
type
TForm1 = class(TForm)
Memo1 : TMemo;
SpinEdit1 : TSpinEdit;
Button1 : TButton;
procedure FormCreate(Sender : TObject);
procedure FormDestroy(Sender : TObject);
procedure Button1Click(Sender : TObject);
private
lpDmArray : PDmArray;
NumModes : integer;
{ }
public
{ }
end;
var
Form1 : TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender : TObject);
var
I : integer; //auto-initialized to zero
MoreModes : bool;
dm : TDeviceMode;
begin
Memo1.Lines.Clear;
MoreModes := True;
while MoreModes do begin
MoreModes := EumDisplaySettings(nil, I, Dm);
Memo1.Lines.Add('Mode '+
IntToStr(i) + ': '+
IntToStr(Dm.DmBitsPerPel) + ' Bits Per Pixel ' +
IntToStr(Dm.DmPelsWidth) + ' X ' +
IntToStr(Dm.DmPelsHeight));
Inc(i);
end;
NumModes := I;
SpinEdit1.MinValue := 0;
SpinEdit1.MaxValue := NumModes;
GetMem(lpDmArray, sizeof(TDeviceMode) * NumModes);
FillChar(lpDmArray^, sizeof(TDeviceMode) * NumModes, #0);
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}
for I := 0 to (NumModes - 1) do
EnumDiaplaySettings(nil, I, lpDmarray[i]);
{$IFDEF CKRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}
end;
procedure TForm1.Button1Click(Sender : TObject);
var
ReturnVal : Longint;
begin
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}
ReturnVal := ChangeDisplaySettings(lpDmArray[SpinEdit1.Value],
CDS_UPDATEREGISTRY);
{$IFDEF CJRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}
with Memo1.Lines do begin
case ReturnVal of
DISP_CHANGE_SUCCESSFUL : Add('DISP_CHANGE_SUCCESSFUL');
DISP_CHANGE_RESTART : Add('DISP_CHANGE_RESTART');
DISP_CHANGE_BADFLAGS : Add('DISP_CHANGE_BADFLAGS');
DISP_CHANGE_FAILED : Add('DISP_CHANGE_FAILED');
DISP_CHANGE_BADMODE : Add('DISP_CHANGE_BADMODE');
DISP_CHANGE_NOTUPDATED : Add('DISP_CHANGE_NOTUPDATED');
end;
end;
end;
procedure TForm1.FormDestroy(Sender : TObject);
begin
FreeMem(lpDmArray, sizeof(TDeviceMode) * NumModes);
end;
end.
●인쇄시 용지 크기를 바꾸려면?
인쇄 작업의 시작에서 프린터의 설정을 변경하기 위해서는 프린터의 디바이스 모드 구조를 변경해야 한다.
※참고
델파이의 DEVMODE 도움말 파일.
다음 예는 사용되는 용지 설정과 용지 크기를 변경하는 코드이다.
procedure TForm1.Button1Click(Sender : TObject);
var
Device : array[0..255] of char;
Driver : array[0..255] of char;
Port : array[0..255] of char;
hDMode : THandle;
PDMode : PDEVMODE;
begin
Printer.PrinterIndex := Printer.PrinetrIndex;
Printer.GetPrinter(Device, Driver, Port, hDMode);
if hDMode <> 0 then begin
pDMode := GlobalLock(hDMode);
if pDMode <> nil then begin
{Set to legal}
pDMode^.DmFields := pDMode^.DmFields or Dm_PaperSize;
pDMode^.DmPaperSize := DMPAPER_LEGAL;
{Set to custom size}
pDMode^.DmFields := pDMode^.DmFieldS or
DM_PAPERSIZE or
DM_PAPERWIDTH or
DM_PAPERLENGTH;
pDMode^.DmPaperSize := DMPAPER_USER;
pDMode^.DmPaperWidth := 100 {SomeValueInTenthsOfAMillimeter};
pDMode^.DmPaperLength := 100 {SomeValueInTenthsOfAMillimeter};
{Set the bin to use}
pDMode^.DmFields := pDMode^.DmFields or DMBIN_MANUAL;
pDMode^.DmDefaultSource := DMBIN_MANUAL;
GlobalUnlock(hDMode);
end;
end;
Printer.PrinterIndex := Printer.PrinterIndex;
Printer.BeginDoc;
Printer.Canvas.TextOut(100, 100, 'Test 1');
Printer.EndDoc;
end;
●코드에서 주어진 프린터의 포트를 변경하려면?
포트를 변경하기 위해서는 TPrinter의 SetPrinter 메소드를 사용할 수 있다.
다음 예는 파일로 인쇄할 포트를 변경하는 것이다.
uses Printers;
{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}
procedure TForm1.Button1Click(Sender : TObject);
var
pDevice : pChar;
pDriver : pChar;
pPort : pChar;
hDMode : THandle;
PDMode : PDEVMODE;
begin
if PrintDialog1.Execute then begin
GetMem(pDevice, cchDeviceName);
GetMem(pDriver, MAX_PATH);
GetMem(pPort, MAX_PATH);
Printer.GetPrinter(pDevice, pDriver, pPort, hDMode);
Printer.SetPrinter(pDevice, PDriver, 'FILE:', hDMode);
FreeMem(pDevice, cchDeviceName);
FreeMem(pDriver, MAX_PATH);
FreeMem(pPort, MAX_PATH);
Printer.BeginDoc;
Printer.Canvas.TextOut(100, 100, 'Delphi is RAD!');
Printer.EndDoc;
end;
end;
●기본 윈도우 프린터를 변경하려면?
Win.ini 파일에서 Windows 섹션의 Device 키에 Device 키에 목록화된 프린터, 드라이버, 포트를 변경하기 위해서 WM_WININICHANGE 메시지를 보내야 한다.
uses
IniFiles;
procedure TForm1.Button1Click(Sender : TObject);
var
WinIni : TIniFile;
WinFileName : array[0..MAX_PATH] of char;
s : array[0..64] of char;
begin
GetWindowDirectory(WinIniFileName, sizeof(WinIniFileName));
StrCat(WinIniFileName, 'win.ini');
WinIni := TIniFile.Create(WinIniFileName);
try
WinIni.WriteString('windows','device', 'HP LaserJet Series II, HPPCL, LPT1 :');
finnaly
WinIni.Free;
end;
StrCopy(S, 'windows');
SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@S));
end;
●윈도우의 시작 메뉴에 현재의 문서들의 목록들을 제거하려면?
윈도우의 API 함수인 SHAddToRecentDocs()에 파일 이름 매개변수에 nil을 넘겨 호출한다.
uses
ShlOBJ;
procedure TForm1.Button1Click(Sender : TObject);
begin
SHAddToRecentDocs(SHARD_PATH, nil);
end;
●Tray 응용프로그램에서 팝업 메뉴가 포커스를 잃을 때 종료되지 않는 경우가 있는데, 종료하려면?
메뉴를 팝업 처리하기 위해서 매시지를 처리할 때, 즉 foreground 윈도우로 설정되었을 때, 팝업 메뉴 후에 WM_NULL 메시지를 보내면 된다.
procedure TForm1.WndProc(var Msg : TMessage);
var
p : TPoint;
begin
case Msg.Msg of
WM_USER + 1:
case Msg.lParam of
WM_RBUTTONDOWN : begin
SetForegroundWindow(Handle);
GetCursorPos(p);
PopupMenu1.Popup(p.x, p.y);
PostMessage(Handle, WM_NULL, 0, 0);
end;
end;
end;
inherited;
end;
●real only 로 설정된 String Grid가 있다. 만약 String Grid에 키 입력을 하려 하고 &Exit 라는 Caption을 가진 버튼이 있을 때, Stringgrid에서 사용자가 x 키를 누를 때마다(Alt 키를 누르지 않았어도), 버튼 클릭이 실행된다. 이를 방지하려면?
다음 예는 폼 레벨에서 DM_DIALOGCHAR 메시지를 가죠 오는 예이다. 이것은 Alt 키를 누른다면 다이얼로그 문자에 응답할 기회를 주는 것으로 문자 단축키의 기본 핸들링을 막는 것이다.
type
TForm1 = class(TForm)
Button1 : TButton;
StringGrid1 : TStringGrid;
procedure FormCreate(Sender : TObject);
procedure Button1Click(Sender : TObject);
procedure StringGrid1KeyDown(Sender : TObject; var Key : Word; Shift :
TShiftState);
private
{ }
procedure CMDialogChar(var Message : TCMDialogChar);
message CM_DIALOGCHAR;
public
{ }
end;
var
Form1 : TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender : TObject);
begin
Button1.Caption := '&Exit';
end;
procedure TForm1.Button1Click(Sender : TObject);
begin
Application.Terminate;
end;
procedure TForm1.StringGrid1KeyDown(Sender : TObject; var Key : Word;
Shift : TshiftState);
begin
ShowMessage('Grid keypress = ' + Char(Key));
Key := 0;
end;
procedure TForm1.CMDialogChar(var Message : TCMDialogChar);
begin
if ssAlt in KeyDataToShiftState(Message.KeyData) then
inherited;
end;
●주어진 파일의 이름 또는 경로명을 알려면?
윈도우 API 함수인 GetShortPathName을 사용하면 된다.
procedure TForm1.Button1Click(Sender : TObject);
var
Buffer : array[0..255] of char;
begin
GetShortPathName('C:Program FilesBorlandCommon FilesBdeBde32.hlp', @buffer,
sizeof(Buffer));
Memo1.Lines.Add(Buffer);
end;
●그룹 지어진 파일이나, 파일을 복사할 때 윈도우 탐색기에서 사용하는 복사 애니메이션 다이얼로그 화면을 사용하려면?
다음 예는 그룹지어진 파일을 복사하는 함수인 SHFileOperation을 사용하고, 처리 과정 다이얼로그를 보여주는 예이다. 삭제, 이동, 이름 변경에 대해서는 다음의 플래그를 사용할 수 있다.
TO_COPY
FO_DELETE
FO_MOVE
FO_RENAME
uses ShellAPI;
procedure TForm1.Button1Click(Sender : TObject);
var
Fo : TSHFileOpStruct;
buffer : array[0..4096] of char;
p : pchar;
begin
FillChar(Buffer, sizeof(Buffer), #0);
p := @buffer;
p := StrECopy(p, 'C:Download1.ZIP') + 1;
p := StrECopy(p, 'C:Download2.ZIP') + 1;
p := StrECopy(p, 'C:Download3.ZIP') + 1;
StrECopy(p, 'C:Download4.ZIP');
FillChar(Fo, sizeof(Fo), #0);
Fo.Wnd := Handle;
Fo.wFunc := FO_COPY;
Fo.pForm := @Buffer;
Fo.pTo := 'D:';
Fo.fFlags := 0;
if ((SHFileOperation(Fo) <> 0) or (Fo.fAnyOperationsAborted <> false)) then
ShowMessage('Cancelled');
end;
●픽셀 배열로부터 Bitmap을 빠르게 생성하려면?
픽셀 배열로부터 Bitmap을 생성하는 방법은 윈도우 API 함수인 CreateDiBitmap()을 사용한다. 이것은 윈도우가 픽셀 데이터를 저장하기 위해서 사용하는 Bitmap 형식에 독립적인 많은 디바이스들 중 하나를 사용하는 것이다. 이것은 윈도우 시스템에서 작동하는 이점을 가진다.
다음의 예는 픽셀 배열로부터 256 Color Bitmap을 생성한다. 이 Bitmap은 256 회색 그림자를 사용하여 흰색에서 검은 색으로 점점 색이 변한다. 윈도우는 시스템 색상들을 사용하기 위해서 첫 번째와 마지막의 10가지 색상들을 따로 보관한다. 그래서 256 회색 그림자들 중 Maximum을 가져올 수 잇다.
{$IFNDEF WIN32}
type
{Used for pointer math under Win16}
PPtrRec = ^TPtrRec;
TPtrRec = record
Lo : Word;
Hi : Word;
end;
{$ENDIF}
{Used for huge pointer math}
function GetBigPointer(lp : pointer; Offset : Longint) : Pointer;
begin
{$IFDEF WIN32}
GetBigPointer := @PByteArray(lp)^[Offset];
{$ELSE}
Offset := Offset + TPtrRec(lp).Lo;
GetBigPointer := Ptr(TPtrRec(lp).Hi + TPtrRec(Offset).Hi * SelectorInc,
TPtrRec(Offset).Lo);
{$EBDIF}
end;
procdure TForm1.Button1Click(Sender : TObject);
var
hPixelBuffer : THandle; {Handle to the pixel buffer}
lpPixelBuffer : pointer; {pointer to the pixel buffer}
lpPalBuffer : PLogPalette; {the palette buffer}
lpBitmapInfo : PBitmapInfo; {The bitmap info header}
BitmapInfoSize : longint; {Size of the bitmap info header}
BitmapSize : longint; {Size of the pixel array}
PaletteSize : integer; {Size of the palette buffer}
I : longint; {loop variable}
j : longint; {loop variable}
OldPal : hPalette; {temp palette}
hPal : hPalette; {handle to our palette}
hBm : hBitmap; {handle to our bitmap}
Bm : TBitmap; {temporary Tbitmap}
Dc : hdc; {used to convert the doB to a DDB}
IsPaletteDevice : bool;
begin
Application.ProcessMessages;
{if range checking is on - turn it off for now}
{we will remember if range checking was on by defining}
{a define called CKRANGE if range checking is on.}
{We do this to access array members past the arrays}
{defined index range without causing a range check}
{error at runtime. To satisfy the compiler, we must}
{also access the indexes with a variable. ie : if we}
{have an array defined as a: array[0..0] of byte,}
{and an integer I, we can now access a[3] by setting}
{i := 3; and then accessing a[i] without error}
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}
{Lets check to see if this is a palette device - if so, then}
{We must do palette handling for a successful operation.}
{Get the screen's dc to use since memory dc's are not reliable}
dc := GetDc(0);
IsPaletteDevice := GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE =
RCPALETTE;
{give back the screen dc}
dc := ReleaseDc(0, dc);
{The bitmap info size must be the size of the BitmapInfo}
{plus the size of the color table - one color table entry}
{is already defined in TBitmapInfo}
BitmapInfoSize := sizeof(TBitmapInfo) + (sizeof(TRGBQUAD) * 255);
{The Bitmap size must be the width of the bitmap rounded}
{up to the nearest 32 bit boundary}
BitmapSize := (sizeof(byte) * 256) * 256;
{The size of the palette must be the size of the bitmap rounded}
{up to the nearest 32 bit boundary}
BitmapSize := (sizeof(byte) * 256) * 256;
{The size of the palette must be the size of a TLogPalette}
{plus the number of color palette entries - 1, since there}
{is already one palette entry defined in TLogPalette}
if IsPaletteDevice then
PaletteSize := sizeof(TLogPalette) + (sizeof(TPaletteEntry) * 255);
{Get the memory for the BitmapInfo, the PixelBuffer, and the Palette}
GetMem(lpBitmapInfo, BitmapInfoSize);
hPixelBuffer := GlobalAlloc(GHND, BitmapSize);
lpPixelBuffer := GlobalLock(hPixelBuffer);
if IsPaletteDevice then
GetMem(lpPalBuffer, PaletteSize);
{Zero out the BitmapInfo, the PixelBuffer, and the Palette}
FillChar(lpBitmapInfo^, BitmapInfoSize, #0);
FillChar(lpPixelBuffer^, Bitmapsize, #0);
if IsPaletteDevice then
FillChar(lpPalBuffer^, PaletteSize, #0);
{Fill in the BitmapInfo structure}
lpBitmapInfo^.bmiHeader.biSize := sizeof(TBitmapInfoHeader);
lpBitmapInfo^.bmiHeader.biWidth := 256;
lpBitmapInfo^.bmiHeader.biHeight := 256;
lpBitmapInfo^.bmiHeader.biPlanes := 1;
lpBitmapInfo^.bmiHeader.biBitCount := 8;
lpBitmapInfo^.bmiHeader.biCompression := BI_RGB;
lpBitmapInfo^.bmiHeader.biSizeImage := BitmapSize;
lpBitmapInfo^.bmiHeader.biXPelsPerMeter := 0;
lpBitmapInfo^.bmiHeader.biYPelsPerMeter := 0;
lpBitmapInfo^.bmiHeader.biClrUsed := 256;
lpBitmapInfo^.bmiHeader.biClrImportant := 256;
{Fill in the BitmapInfo color table with gray shades : black to white}
for I := 0 to 255 do begin
lpBitmapInfo^.bmiColors[i].rgbRed := I;
lpBitmapInfo^.bmiColors[i].rgbGreen := I;
lpBitmapInfo^.bmiColors[i].rgbBlue := I;
end;
{Fill in the pixel buffer array with shades : black to white}
{In a 256 color bitmap the color is an index into the color table}
for I := 0 to 255 do
for j := 0 to 255 do
Byte(GetBigPointer(lpPixelBuffer, i+(j*256))^) := j;
{Fill in the palette structure}
if IsPaletteDevice then begin
lpPalBuffer^.palVersion := $300;
lpPalBuffer^.palNumEntries := 256;
{Fill in the palette structure color table}
for I := 0 to 255 do begin
lpPalBuffer^.PalPalEntry[i].peRed := I;
lpPalBuffer^.PalPalEntry[i].peGreen := I;
lpPalBuffer^.PalPalEntry[i].peBlue := I;
end;
{Create a palette}
hPal := CreatePalette(lpPalBuffer^);
end;
{Get the screen's dc to use for the sonversion since}
{memory dc's are not reliable to ues for conversions}
dc := GetDc(0);
if IsPaletteDevice then begin
{If we are using a palette, it must be}
{selected into the dc during the conversion}
OldPal := SelectPalette(dc, hPal, True);
{Realize the palette}
RealizePalette(dc);
end;
{Do the conversion}
hBm := CreateDiBitmap(dc, lpBitmapInfo^.bmiHeader, CBM_INIT, pChar(lpPixelBuffer),
lpBitmapInfo^, DIB_RGB_COLORS);
if IsPaletteDevice then begin
{Select the Old palette back in}
SelectPalette(dc, OldPal, true);
{Realize the old palette}
RealizePalette(dc);
end;
{Give back the screen dc}
dc := ReleaseDc(0, dc);
{Create a temporory TBitmap}
bm := Tbitmap.Create;
{Free up the memory we used}
if IsPaletteDevice then
FreeMem(lpPalBuffer, PaletteSize);
GlobalUnlock(hPixelBuffer);
GlobalFree(hPixelBuffer);
FreeMem(lpBitmapInfo, BitmapInfoSize);
{Assign the palette}
if IsPaletteDevice then
bm.Palette := hPal;
{Assign the handle}
bm.Handle := hBm;
{Size Image1}
Image1.Width := 256;
Image1.Height := 256;
{Assign the bitmap}
Image1.Picture.Bitmap := bm;
SelectPalette(Image1.Picture.Bitmap.Canvas.Handle, Image1.Picture.Bitmap.Palette, false);
{Turn range checking back on if it was on when we started}
{$IFDEF CKRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}
end;
●TTimer 컴포넌트를 사용하지 않고, 시스템을 Lock하지 않고 지연시키려면?
다음 예는 시간의 체크하는 루프를 사용하고, 루프가 실행되는 동안 처리된 윈도우 메시지들을 수행하도록 하는 Application.ProcessMessages를 호출한다.
procedure Delay(ms : longint);
var
TheTime : LongInt;
begin
TheTime := GetTickCount + ms;
while GetTickCount < YheTime do
Application.ProcessMessages;
end;
procedure TForm1.Button1Click(Sender : TObject);
begin
ShowMessage('Start Test');
Delay(2000);
ShowMessage('End Test');
end;
●Flashing Icon을 생성하려면?
윈도우 API 함수인 FlashWindow()을 호출한다.
var
Flash : bool;
procedure TForm1.Timer1Timer(Sender : TObject);
begin
FlashWindow(Form1.Handle, Flash);
FlashWindow(Application.Handle, Flash);
Flash := not Flash;
end;
procedure TForm1.FormCreate(Sender : TObject);
begin
Flash := False;
end;
●RTL은 하나의 입력 Palette에만 TLogPallette를 정의한다. 그런데 하나 이상의 입력을 가진 Palette를 생성하려면?
RTL은 원하는 팔레트 입력들의 수를 가진 Palette를 동적으로 생성하도록 하기 위해서, 오직 한 개의 입력을 가진 TLogPalette를 정의한다. 추가적인 입력들을 액세스 하기 위해서 범위 체크가 없애야 한다. 그리고 변수를 사용하여 Palette 입력 인덱스를 액세스해야만 한다.
다음 예는 256 입력들을 가진 논리적 Palette 구조를 동적으로 생성하는 것이다. 범위 체크를 없애고, 회색 그림자로 그들을 채움으로써 Palette 입력들을 액세스한다. 그리고 Palette 에 핸들을 생성하고, 할당된 리소스들을 없앤다.
procedure TForm1.Button1Click(Sender : TObject);
var
lpPalette : PLogPalette;
hPal : hPalette;
I : integer;
begin
{palette에 사용된 메모리를 할당한다.}
GetMem(lpPalette, sizeof(TLogPalette)+ (255*sizeof(TPaletteEntry)));
{palette header를 채운다}
lpPalette^.palVersion := $300;
lpPalette^.palNumEntries := 256;
{범위 체크를 없앤다.}
{범위 체크 상태를 기억한다.}
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}
{회색 그림자로 palette 구조 색상 테이블을 채운다.}
for I := 0 to 255 do begin
lpPalette^.PalPalEntry[i].peRed := I;
lpPalette^.PalPalEntry[i].peGreen := I;
lpPalette^.PalPalEntry[i].peBlue := I;
end;
{Turn range checking back on if it was on when we started}
{$IFDEF CKRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}
{palette 핸들을 생성한다.}
hPal := CreatePalette(lpPalette^);
{palette 구조에 의해서 메모리 사용을 해제한다.}
FreeMem(lpPalette, sizeof(TLogPalette) + (255*sizeof(TPaletteEntry)));
{이 부분에 palette를 가지고 코딩을 한다.}
{사용 후에 palette 핸들을 삭제한다.}
DeleteObject(hPal);
end;
●회전되는 글자체를 생성하려면?
TrueType 글씨체를 사용해야 한다.
다음의 코드는 45도로 회전하는 글꼴을 생성하는 예이다.
procedure TForm1.Button1Click(Sender : TObject);
var
lf : TLogFont;
tf : TFont;
begin
with Form1.Canvas do begin
Font.Name := 'Arial';
Font.Size := 24;
tf := TFont.Create;
tf.Assign(Font);
GetObject(tf.Handle, sizeof(lf), @lf);
lf.lfEscapement := 450;
lf.lfOrientation := 450;
tf.Handle := CreateFontIndirect(lf);
Font.Assign(tf);
tf.Free;
TextOut(20, Height div 2, 'Rotated Text!');
end;
end;
●Language 정의를 받아 들이는 윈도우 API 함수들을 가지고 사용된 PRIMARYLANGID() , SUBLANGID() and MAKELANGID() 매크로들을 정의하려면?
다음 예는 PRIMARYLANGID(), SUBLANGID(), 그리고 MAKELANGID() 메크로에 대해 동등한 기능을 하는 예제이다.
function PRIMARYLANGID(lgid : Word) : LongInt;
begin
result := lgid and $3FF;
end;
function SUBLANGID(lgid : Word) : LongInt;
begin
result := lgid shr 10;
end;
function MAKELANGID(sPrimaryLanguage : Word; sSubLanguage : Word) : Word;
begin
result := (sSubLanguage shl 10) or sPrimaryLanguage;
end;
●주어진 시간에 Windows 인쇄 스풀러에서 얼마나 많은 인쇄 작업이 있는지를 알아내는 방법은?
Windows 인쇄 스풀러는 스풀러 큐로부터 추가되거나 삭제될 때마다 WM_SPOOLERSTATUS 메시지를 보낸다.
다음 예는 이 메시지를 가져 오는 예이다.
type
TForm1 = class(TForm)
Label1 : TLabel;
private
{ }
procedure WM_SpoolerStatus(var Msg : TMSPOOLERSTATUS);
message WM_SPOOLERSTATUS;
public
{ }
end;
var
Fomr1 : TForm1;
implementation
{$R *.DFM}
procedure TForm1.WM_SpoolerStatus(var Msg : TWMSPOOLERSTATUS);
begin
Label1.Caption := InttoStr(msg.JobLeft) + ' Jobs currenly in spooler');
msg.Result := 0;
end;
●PrintScreen 키를 눌렀는지 알 수 있는 방법은?
PrintScreen 시스템 키는 TForm의 Keydown 이벤트에서 처리되지 않는ㄷ다.
다음 예는 Application.OnIdle 이벤트에서 API 함수인 GetAsyncKeyState()를 호출함으로써 PrintScreen 키를 눌렀는지를 테스트하는 것이다.
type
TForm1 = class(TForm)
Button1 : TButton;
procedure formCreate(Sender : TObject);
private
{ }
procedure AppIdle(Sender : TObject; var done : Boolean);
public
{ }
end;
var
Form1 : TForm1;
implementation
{$R &.DFM}
procedure TForm1.FormCreate(Sender : TObject);
begin
Application.OnIdle := AppIdle;
end;
procedure TForm1.AppIdle(Sender : TObject; var done : Boolean);
begin
if GetAsyncKeystate(VK_SNAPSHOT) <> 0 then
Form1.Caption := 'SnapShot');
done := true;
end;
●다른 응용프로그램에 의해서 시스템 시간이 변경되었는지를 알아내는 방법은?
다은 예는 WM_TIMECHANGE 메시지를 가져 오는 예제이다.
시스템 시간이 변경된 응용프로그램은 모든 상위 레벨 윈도우들에게 WM_TIMECHANGE 메시지를 보낸다.
type
TForm1 = class(TForm1)
private
{ }
procedure WMTIMECHANGE(var Message : TWMTIMECHANGE);
message WM_TIMECHANGE;
public
{ }
end;
var
Form1 : TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMTIMECHANGE(var Message : TWMTIMECHANGE);
begin
Form1.Caption := 'Time Changed';
end;
●DLL이 어디에서 실행되었는지 완전한 경로명과 파일 이름을 알아내려면?
다음 예는 DLL이 로드된 곳은 경로명을 알아내는 DLL 함수에 대한 것이다.
uses Windows;
procedure ShowDllPath stdcall;
var
TheFileName : array[0..MAX_PATH] of char;
begin
Fillchar(TheFileName, sizeof(TheFileName), #0);
GetModulefileName(hInstance, TheFileName, sizeof(TheFileName));
MessageBox(0, TheFileName, 'The DLL file name is : ', mb_ok);
end;
●주어진 파일에 대한 최근 액세스 시간을 정의하려면?
다음 예는 주어진 파일이 액세스된 날짜와 시간을 가져 오는 것이다. 모든 파일 시스템들이 최신 액세스 시간을 지원하는 것은 아니다.
procedure TForm1.Button1Click(Sender : TObject);
var
SearchRec : TSearchRec;
Success : integer;
DT : TFileTime;
ST : TSystemTime;
begin
Success := SysUtils.FindFirst('C:autoexec.bat', faAnyfile, SearchRec);
if ((Success = 0) and
((TLargeInteger(searchRec.FindData.ftLastAccessTime).LowPart <> 0) or
((TLargeInteger(searchRec.FindData.ftLastAccessTime).HighPart <> 0))) then
begin
FileTimeToLocalFileTime(SearchRec.FindData.ftLastAccessTime, DT);
FileTimeToSystemTime(DT, ST);
Memo1.Lines.Clear;
Memo1.Lines.Add('AutoExec.bat was last accessed at : ');
Memo1.Lines.Add('Year := ' + IntToStr(st.wYear));
Memo1.Lines.Add('Month := ' + IntToStr(st.wMonth));
Memo1.Lines.Add('DayofWeek := ' + IntToStr(st.wDayOfWeek));
Memo1.Lines.Add('Day := ' + IntToStr(st.wDay));
Memo1.Lines.Add('Hour := ' + IntTostr(st.wHour));
Memo1.Lines.Add('Minute := ' + IntToStr(st.wMinute));
Memo1.Lines.Add('Second := ' + InttoStr(st.wSecond));
Memo1.Lines.Add('Milluseconds := ' + IntToStr(st.wMilliseconds));
end;
SysUtils.FindClose(SearchRec);
end;
●주어진 프린터가 PostScript 파일에 대해서 인쇄가 가능한지를 알려면?
다음 예제 코드는 주어진 프린터가 Adobe PostScript 페이지에 대해서 지원하는지를 알아내는 예제이다.
uses Printers;
function IsPostScriptPrinter(dc : hdc) : bool;
var
TestInt : integer;
a : array[0..255] of char;
err : integer;
s : string;
begin
Result := false;
TestInt := GETTECHNOLOGY;
{$IFEDF WIN32}
if ExtEscape(Dc, QUERYESCSUPPORT, sizeof(TestInt), @TestInt, 0, Nil) > 0 then
begin
Err := ExtEscape(Dc, GETTECHNOLOGY, 0, nil, 256, @a);
{$ELSE}
if ExtEscape(Dc, QUERYESCSUPPORT, sizeof(TestInt), @TestInt, 0, Nil) > 0 then
begin
Err := ExtEscape(Dc, GetTechnology, 0, nil, @a);
{$ENDIF}
if Err > 0 then begin
s := UpperCase(StrPas(a));
if Pos('POSTSCRIPT', s) > 0 then
result := true;
end;
end;
end;
procedure TForm1.Button1Click(Sender : TObject);
begin
if PrintDialog1.Execute then
if IsPosScriptPinter(Printer.Handle) then
ShowMessage('This is a Postscript Printer') else
ShowMessage('This is not a Postscript Printer');
end;
●주어진 윈도우의 종료 버튼을 사용하지 못하게 하려면?
다음 예는 주어진 윈도우에서 종료 버튼을 사용하지 못하도록 하는 예이다.
peoceudre TForm1.Button1Click(Sender : TObject);
var
hwndHandle : THANDLE;
hMenuHandle : HMENU;
begin
hwndHandle := FindWindow(nil, 'Untitled - notepad');
if (hwndHandle <> 0) then begin
hMenuHandle := GetSystemMenu(hwndHandle, False);
if (hMenuHandle <> 0) then
DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
end;
end;
●Win95의 시작 버튼을 숨기거나 사용하지 못하게 하려면?
다음 예는 윈도우 시작 버튼을 숨기거나 나타나게 하고 또한 사용이 가능하거나 불가능하도록 하는 예이다.
procedure TForm1.Button1Click(Sender : TObject);
var
Rgn : hRgn;
begin
{Hide the start button}
Rgn := CreateRectRgn(0, 0, 0, 0);
SetwindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil) ,Rgn
, true);
end;
procedure TForm1.Button2Click(Sender : TObject);
begin
{Turn the start button back on}
SetwindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil) ,0
, true);
end;
procedure TForm1.Button3Click(Sender : TObject);
begin
{Disable the start button}
EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd'), nil), 0, 'Button', nil),
false );
end;
procedure Tform1.Button4click(Sender : TObject);
begin
{enable the start button}
EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd'), nil), 0, 'Button', nil),
true );
end;
end.
●VB 함수 중 doEvent 와 동등한 것으로 델파이에서 사용하는 것은?
Application.ProcessMessages.
●RichEdit 컨트롤에서 Page Brake를 추가하려면?
불가능하다. Page라는 명령은 RichEdit 컨트롤로부터 제거되는 것이다.
●윈도우 API CallBack 함수인 EnumFontFamilies()를 사용하는 방법은?
다음 예는 TMemo 컴포넌트에 현재 프린터에 대한 글꼴과 사이즈의 목록들을 추가하는 것이다.
uses Printers;
function EnumFontFamilyProc(var lf : TLogFont;
var tm : TNewTextMetric;
FontType : integer;
var Memo : TMemo) : integer;
{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}
begin
Memo.Lines.Add(StrPas(@lf.lfFaceName) + #32 + IntToStr(lf.lfHeight));
result := 1;
end;
function EnumFontFamiliesProc(var lf : TLogFont;
var tm : TNewTextMetric;
FontType : integer;
var Memo : TMemo) : integer;
{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}
begin
if FontType = TRUETYPE_FONTTYPE then begin
Memo.Lines.Add(StrPas(@lf.lfFaceName) + #32 + 'All Sizes');
end else
EnumFontFamilies(Printer.Handle, @lf.lfFaceName, @EnumFontFamilyProc,
LongInt(@Memo));
result := 1;
end;
procedure TForm1.Button1Click(Sender : TObject);
var
tm : TTextMetric;
I : integer;
begin
if PrintDialog1.Execute then begin
EnumFontFamilies(Printer.Handle, nil, @EnumFontFamiliesProc, LongInt(@Memo1));
end;
end;
●'.LNK' 파일을 실행하려면?
다음 예느 윈도우의 시작 메뉴에서 .lnk 파일을 실행하는 예제이다.
uses ShellApi;
procedure TForm1.Button1Click(Sender : TObject);
begin
ShellExecute(0,
nil,
'C:WINDOWSSTART MEMUDELPHI|Delpgi5.lnk',
nil,
nil,
SW_SHOWNORMAL);
end;
●응용프로그램으로부터 다른 프로그램들을 실행하려면?
WinExec 함수는 응용프로그램에서 다른 응용프로그램을 실행시키는 가장 쉬운 방법이다. 또는 위의 ‘LNK 파일을 실행하는 방법’ 부분에서 설명한 ShellExecute API 함수를 사용할 수도 있다. 관련된 API 함수의 도움말은 ‘Borland SharedMSHELPWind32.hlp 도움말 파일’을 참고하기 바란다.
WinExec를 이용하여 일반적인 프로그램을 실행하려면 다음과 같이 한다.
WinExec('C:WINDOWSNOTEPAD.EXE', SW_SHOWNORMAL);
WunExec('C:WINDOWSNOTEPAD.EXE C:WINDOWSWIN.INI',
SW_SHOWNORMAL);
Dos 화면을 보이기 위해서는 ..
WinExec('COMMAND.COM', SW_SHOWNORMAL);
Dos 명령을 수행하기 위해서는 ..
WinExec('COMMAND.COM /C DIR *.*', SW_SHOWNORMAL);
●윈도우 탐색기의 파일 찾기의 다일얼로그 박스를 실행하려면?
다음 예는 DDE를 사용하여 탐색기의 파일 찾기 다이얼로그를 수행하는 예이다.
이것은 “C:DownLoad" 디렉토리에서 다이얼로그를 연다.
procedure TForm1.Button1click(Sender : TObject);
begin
with TDDEClientConv.Create(Self) do begin
ConnectMode := ddeManual;
ServiceApplication := 'explorer.exe';
SetLink('Folders', 'AppProperties');
OpenLink;
ExecuteMacro('FindFolder(, C:DOWNLOAD)]', False);
CloseLink;
Free;
end;
end;
●ShellAPI 함수인 ExtractIconEX()를 가지고 주어진 파일로부터의 작은 아이콘, 큰 아이콘을 추출하려면?
ShellAPI 함수인 ExtracIconEx() 는 실행 파일, 동적 링크 라이브러리(DLL) 또는 아이콘 파일에 사용할 수 있다.
다음은 함수에 대한 정의이다.
Function ExtractIconEx(lpszFile : PAnsiChar;
nIconIndex : Integer;
phiconLarge : PhIconArray;
phiconSmall : PhIconArray;
nIcons : UNIT) : UNIT ; stdcall;
다음은 매개변수를 설명할 것이다.
---------------------------------------------------------------------
매개변수 설명
---------------------------------------------------------------------
lpszFile 아이콘을 추출하려는 실행 파일, DLL, 또는 아이콘 파일의 이름을 Null
종료 문자열로 정의하는 포인터.
nIconIndex 아이콘의 인덱스를 정의한다. 만약 값이 0이라면 함수는 정의된 파일에 대
해서 첫 번째 아이콘의 핸들을 리턴한다. 값이 -1이라면, 그리고
phiconLarge 과 phiconSmall 이 모든 nil 이라면 함수는 실행 파일, dll, 또
는 아이콘 파일에 아이콘의 총 수를 리턴한다. 파일이 실행파일이거나
DLL이라면 리턴 값은 RT_GROUP_ICON 리소스들의 수이다. 만약 .ICO
라면 리턴 값은 1이다.
phiconLarge 큰 아이콘에 대한 아이콘 핸들들에 대한 배열 포인터로 이 매개변수는 오
직 한 개의 아이콘이 추출되면 nil 값을 가질 수 있다.
nIcons 아이콘의 수를 정의한다.
Return Value 리턴 값은 오직 한 개의 아이콘이라면 아이콘에 대한 핸들이다. 그리고 파
일에서 어떤 아이콘도 찾을 수 없다면 리턴 값은 0이다.
---------------------------------------------------------------------
다음 예는 ExtractIconEx() 함수를 사용하느 예이다.
함수의 완전한 사용을 허락하기 위해서 ShellAPI 유닛에 정의된 것과 다르게 함수가 정의된 것을 주의하라.
type ThIconArray = array[0..0] of hIcon;
type PhIconArray = ^ThIconArray;
function ExtracIconExA(lpszFile : PAnsiChar;
nIconIndex : Integer;
phiconLarge : PhIconArray;
phiconSmall : PhIconArray;
nIcons : UINT) : UNIT ; stdcall;
external 'shell32.dll' name 'ExtracIconExA';
function ExtracIconExW(lpszFile : PWideChar;
nIconIndex : Integer;
phiconLarge : PhIconArray;
phiconSmall : PhIconArray;
nIcons : UINT) : UNIT ; stdcall;
external 'shell32.dll' name 'ExtracIconExW';
function ExtractIconEx(lpszFile : PAnsiChar;
nIconIndex : integer;
phiconLarge : PhIconArray;
phiconSmall : PhIconArray;
nIcons : UNIT) : UNIT; stdcall;
external 'shell32.dll' name 'ExtracIconExA';
procedure TForm1.Button1Click(Sender : TObject);
var
NumIcons : Integer;
pTheLargeIcons : phIconArray;
pThrSmallIcons : phIconArray;
LargeIconWidth : integer;
SmallIconWidth : integer;
SmallIconHeight : integer;
I : integer;
TheIcon : TIcon;
TheBitmap : TBitmap;
begin
NumIcons :=
ExtractIconEx('C:Program FilesBorlandDelphi 5BINDelphi32.exe', -1, nil, nil, 0);
if NumIcons > 0 then begin
LargeIconWidth := GetsystemMetrics(SM_CXICON);
SmallIconWidth := GetSystemMetrics(SM_CXSMICON);
SmallIconHeight := GetsystemMetrics(SM_CYSMICON);
GetMem(pTheLargeIcons, NumIcons * sizeof(hIcon));
GetMem(pTheSmallIcons, NumIcons * sizeof(hIcon));
FillChar(pTheLargeIcons^, NumIcons * sizeof(hIcon), #0);
FillChar(pTheSmallIcons^, NumIcons * sizeof(hIcon), #0);
ExtractIconEx('C:Program FilesBorlandDelphi 5BINdelphi32.exe',
0,
pTheLargeIcons,
pTheSmallIcons,
numIcons);
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}
for I := 0 to (NumIcons - 1) do begin
DrawIcon(Form1.Canvas.Handle, i*LargeIconWidth, 0, pTheLargeIcons^[i]);
TheIcon := TIcon.Create;
TheBitmap := TBitmap.Create;
TheIcon.Handle := pTheSmallIcons^[i];
TheBitmap.Width := TheIcon.Width;
TheBitmap.Height := TheIcon.Height;
TheBitmap.Canvas.Draw(0,0, TheIcon);
TheIcon.Free;
Form1.Canvas.StrectchDraw(Rect(i * SmallIconWidth,
100,
(i + 1) * SmallIconHeight),
TheBitmap);
TheBitmap.Free);
end;
{$IFDEF CKRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}
FreeMem(pTheLargeIcons, NumIcons * sizeof(hIcon));
FreeMem(pTheSmallIcons, NumIcons * sizeof(hIcon));
end;
end;
end.
●주어진 Canvas를 지우는 가장 빠른 방법은?
윈도우 API 함수인 PatBlt()를 사용하면 된다.
procedure TForm1.Button1Click(Sender : TObject);
begin
PatBlt(Form1.Canvas.Handle, 0 , 0, Form1.ClientWidth, Form1.ClientHeight,
WHITENESS);
end;
●Win32 아래의 드라이브를 포맷하려면?
ShellAPI 함수인 shFormatDrive()를 사용할 수 있다.
const SHFMT_DRV_A = 0;
const SHFMT_DRV_B = 1;
const SHFMT_ID_DEFAULT = $FFFF;
const SHFMT_OPT_QUICKFORMAT = 0;
const SHFMT_OPT_FULLFORMAT = 1;
const SHFMT_OPT_SYSONLY = 2;
const SHFMT_ERROR = -1;
const SHFMT_CANCEL = -2;
const SHFMT_NOFORMAT = -3;
function SHFormatDrive(hWnd : HWND;
Drive : Word;
fmtID : Word;
Option : Word) : Longint
stdcall; external 'Shell32.dll' name 'SHFormatDrive');
procedure TForm1.Button1click(Sender : TObject);
var
FmtRes : longint;
begin
try
FmtRes := ShformatDrive(Handle,
SHFMT_DRV_A,
SHFMT_ID_DEFAULT,
SHFMT_OPT_QUICKFORMAT);
case FmtRes of
SHFMT_ERROR : ShowMessage('Error formatting the drive');
SHFMT_CANCEL :
ShowMessage('User canceled formatting the drive');
SHFMT_NOFORMAT : ShowMessage('No Format');
else
ShowMessage('Disk has been formatted');
except
end;
end;
●Windows Console 응용프로그램을 일반화하려면?
새로운 응용프로그램을 시작하고, Project Manager를 시작하여 프로젝트의 모든 유닛을 제거한다. 그리고 Project Source 에 다음의 코드를 추가한다.
program Project1;
uses
Windows;
{$R *.RES}
begin
Write('A Console Application');
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
FOREGROUND_RED OR BACKGROUND_BLUE);
Writeln('Red text on a blue background');
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
FOREGROUND_BLUE OR BACKGROUND_RED);
writeln('Blue text on a red background');
{write text on black background}
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
FOREGROUND_RED OR
FOREGROUND_GREEN OR
FOREGROUND_BLUE);
Writeln('Press Enter To End');
Readln;
end.
●시스템에서 가능한 드라이브들의 목록을 가져 오는 가장 빠른 방법은?
다음 예는 시스템에서 가능한 논리적 드라이브들의 리스트를 가져 오는 것이다.
procedure TForm1.Button1Click(Sender : TObject);
var
ld : DWORD;
I : integer;
begin
il := GetLogicalDrives;
for I := 0 to 25 do begin
if (ld and (1 shl I)) <> 0 then
Memo1.Lines.Add(Char(Ord('A') + I) + ':');
end;
end;
●DeviceCapabilities 를 사용하여 특정 프린터에 대한 모든 빈들의 이름들을 가져 오려면?
다음 코드를 참조하기 바란다. 델파이에서 새로운 프로젝트를 시작하여 TButton 과 TMemo를 가져다 놓는다. 버튼의 on_click 이벤트에 다음과 같이 코드를 작성한다.
uses
WinSpool;
const
pName = 'DELPHI III';
pPort = '\CONANDELPHI_III';
procedure TForm1.Button1Click(Sender : TObject);
var
I : Integer;
p : pChar;
begin
GetMem(p, 24*DeviceCabilities(pName, PPort, DC_BINNAMES, nil, nil));
with Memo1.Lines do begin
Clear;
for I:= 1 to DeviceCapabilities(pName, PPort, DC_BINNAMES, p, nil) do
Add(p+24*(i-1));
end;
FreeMem(p);
end;
●Win32 아래에서 모뎀의 상태를 가져 오려면?
다음 예는 Win32 아래에서 모뎀 Control-Register 값들을 가져 오는 것이다.
peocedure TForm1.Button1Click(Sender : TObject);
var
CommPort : string;
hCommFile : THandle;
ModemStart : DWord;
begin
CommPort := 'COM2';
{Open the comm port}
hCommFile := CreateFile(PChar(CommPort),
GENERIC_READ,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
if hCommFile = INVALID_HANDLE_VALUE then
begin
ShowMessage('Unable to open ' + CommPort);
exit;
end;
{Get the Modem Status}
if GetCommMedemStatus(hCommFile, ModemStart) <> false then begin
if MedemStat and MS_CTS_ON <> 0 then
ShowMessage('The CTS (clear-to-send) is on.');
if ModemStat and MS_DSR_ON <> 0 then
ShowMessage('The DSR (data-set-ready) is on.');
if MedemStat and MS_RING_ON <> 0 then
ShowMessage('The ring indicator is on.');
if ModemStat and MS_RLSD_ON <> 0 then
ShowMessage('The RLSD (receive-line-singnal-detect) is on.');
end;
{Close the comm port}
CloseHandle(hCommFile);
end;
●TPrinter 의 GetPrinter() 메소드들로부터 Printer의 드라이버나 포트명을 가져 오려면?
보통 이들 매개변수들은 빈 문자열을 리턴한다. Windows.ini 파일로부터 할당된 Driver 와 Port를 가져 오기 위해서 윈도우 API 함수인 GetProfileString()을 사용할 수 있다.
uses Printers;
{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}
procedure TForm1.Button1Click(Sender : TObject);
var
pDevice : pChar;
pDriver : pChar;
pPort : pChar;
hDMode : THandle;
begin
if PrintDialog1.Execute then begin
GetMem(pDevice, cchDeviceName);
GetMem(pDriver, MAX_PATH);
GetMem(pPort, MAX_PATH);
Printer.GetPrineter(pDevice, pDevice, '', pDriver, MAX_PATH);
if lStrLen(pDriver) = 0 then begin
GetProfileString('Devices', pDevice, '', pDriver, MAX_PATH);
pDriver[pos(',', pDriver) - 1] := #0;
end;
if lStrLen(pPort) = 0 then begin
GetProfileString('Device', pDevice, '', pPort, MAX_PATH);
lsStrCpy(pPort, @pPort[lsStrLen(pPort)+2]);
end;
Memo1.Lines.Add('Device := ' + StrPas(pDevice));
Memo1.Lines.Add('Driver := ' + StrPas(pDriver));
Memo1.Lines.Add('Port := ' + StrPas(pPort));
FreeMem(pDevice, cchDeviceName);
FreeMem(pDriver, MAX_PATH);
FreeMem(pPort, MAX_PATH);
end;
end;
●Dos 화면이나 모든 Console 응용프로그램을 포함하는 윈도우의 핸들을 가져 오려면?
다음 예는 Console 모드 응용프로그램의 핸들을 가져 오기 위해서 윈도우 API 함수인 FindWindow()을 사용하는 예이다.
Console Window의 WndClass 는 윈도우95와 윈도우 NT를 사용하는 경우가 다르고 윈도우의 타이틀도 윈도우 NT에서는 완전한 경로명을 포함한다.
procedure TForm1.Button1Click(Sender : TObject);
var
info : TOSVersionInfo;
ClassName : string;
Title : string;
begin
{See if we're running on Win95 or NT.}
info.dwOSVersionInfoSize := sizeof(info);
GetVersionEx(info);
if (info.dwPlatformId = VER_PLATFORM_WIN32_NT) then begin
ClassName := 'ConsoleWindowClass';
Title := 'MS-DOS Prompt';
end;
ShowMessage(IntToStr(FindWindow(PChar(ClassName), PChar(Title))));
end;
●페이지의 인쇄 여백을 얻어 오려면?
PHYSICALOFFSETX 와 PHYSICALOFFSETY 상수를 전달하는 윈도우 API 함수인 GetDeviceCaps()를 호출한다.
uses Printers;
procedure TForm1.Button1Click(Sender : TObject);
var
EscapeCode : integer;
Margin : TPoint;
begin
if PrintDialog1.Execute then begin
{$IFDEF WIN32}
Margin.x := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
Margin.y := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
{$ELSE}
EscapeCode := GETPRINTINGOFFSET;
if Escape(Printer.Handle,
QUERYSCSUPPORT,
sizeof(EscapeCode),
@EscapeCode, nil) <> 0 then
if Escape(Printer.Handle,
QUERYSCSUPPORT,
0,
nil, @Margin) < 1 then begin
EscapeCode := GETPHYSPAGESIZE;
if Escape(Printer.Handle,
QUERYSCSUPPORT,
sizeof(EscapeCode),
@EscapeCode, nil) <> 0 then
if Escape(Printer.Handle,
GETPHYSPAGESIZE,
0,
nil, @Margin) > 0 then begin
Margin.x := (Margin.x - GetDeviceCaps(Pinter.Handle, HorzRes)) div 2;
Margin.y := (Margin.y - GetDeviceCaps(Pinter.Handle, VertRes)) div 2;
end else begin
Margin.x := 0;
Margin.y := 0;
end;
end;
{$ENDIF}
Memo1.Lines.Add(IntToStr(Margin.x));
Memo1.Lines.Add(IntToStr(Margin.y));
end;
end;
●디스크의 시리얼 숫자를 가져 오려면?
윈도우 API 함수인 GetVolumnInformation()을 사용한다.
procedure TForm1.Button1Click(Sender : TObject);
var
VolumnSerialNumber : DWORD;
MaximunCoponentLength : DWORD;
FileSystemFlags : DWORD;
SerialNumber : string;
begin
GetVolumeInfomation('C:',
nil,
0,
@VolumeSerialNumber,
MaxinumComponentLength,
FilesystemFlags,
nil,
0);
Serialnumber := IntToHex(HiWord(VolumeSerialNumber), 4) + '-' +
IntToHex(LoWord(VolumeSerialNumber), 4);
Memo1.Lines.Add(SerialNumber);
end;
●Universal Time에서 시간과 날짜를 얻어 오려면?
윈도우 API 함수인 GetSystemTime을 사용한다.
procedure TForm1.Button1Click(Sender : TObject);
var
lt : TSYSTEMTIME;
st : TSYSTEMTIME;
begin
GetLocalTime(lt);
GetSystemTime(st);
Memo1.Lines.Add('LocalTime = ' +
IntToStr(lt.wmonth) + '/' +
IntToStr(lt.wDay) + '/' +
IntToStr(lt.wYear) + '' +
IntToStr(lt.wHour) + ':' +
IntToStr(lt.wMinute) + ':' +
IntToStr(lt.wSecond));
Memo1.Lines.Add('UTCTime = ' +
IntToStr(st.wmonth) + '/' +
IntToStr(st.wDay) + '/' +
IntToStr(st.wYear) + '' +
IntToStr(st.wHour) + ':' +
IntToStr(st.wMinute) + ':' +
IntToStr(st.wSecond));
end;
●윈도우로부터 사용자명과 회사 정보를 가져 오려면?
윈도우의 레지스트리의 “HKEYCURRENT USER" 섹션 아래에 이 정보가 저장되어 있다. TRegIniFile을 사용하여 입력 정보를 가져 온다.
uses Registry;
procedure TForm1.Button1Click(Sender : TObject);
var
reg : TRegIniFile;
begin
reg := TRegIniFile.Create('SOFTWAREMICROSOFTMS SETUP(ACME)');
Memo1.Lines.Add(reg.ReadString('USER INFO', 'DefName', 'Frank Borland'));
Memo1.Lines.Add(reg.ReadString('USER INFO', 'DefCompany', 'A Valued Borland
Customer'));
reg.free;
end;
●응용프로그램의 시작 동안 키를 눌렀는지 알려면?
윈도우 API 함수인 GetKeyState를 사용하여 메인 프로젝트 소스에서 키를 눌렀는지를 체크한다.
program Project1;
uses
Windows, Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
begin
if GetKeyState(vk_F8) < 1 then
MessageBox(0, 'F8 was pressed during startup', 'MyApp', bm_ok);
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
●설치된 com 포크들의 이름들을 알려면?
다음은 Win32 레지스트리에 설치된 정보를 가져 오는 예이다.
uses Registry;
procedure TForm1.Button1Click(Sender : TObject);
var
reg : TRegistry;
ts : TStrings;
I : integer;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('hardwaredevicemapserialcomm', false);
ts := TStringList.Create;
reg.GetValueNames(ts);
for I := 0 to ts.Count-1 do begin
Memo1.Lines.Add(reg.ReadString(ts.Strings[i]));
end;
ts.Free;
reg.CloseKey;
reg.free;
end;
●Win32 아래에서 모뎀을 통해서 전화하는 방법은?
com 포크에 대한 핸들을 가져 오기 위해서 윈도우 API 함수인 CreateFile()을 사용 할 수 있다. 그리고 주어진 포트를 가지고 통신하기 위해서 표준 파일 I/O를 사용한다.
var
hCOmmFile : THandle;
procedure TForm1.Button1Click(Sender : TObject);
var
PhoneNumber : String;
CommPort : string;
NumberWritten : LongInt;
begin
PhoneNumber := 'ATDT 1-555-555-1212' + #13 + #10;
CommPort := 'COM2';
{Open the comm port}
hCommFile := CreateFile(PChar(CommPort),
GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
if hCommFile = INVALID_HANDLE_VALUE then
begin
ShowMessage('Unable to open '+ CommPort);
exit;
end;
{Dial the phone}
NumberWritten := 0;
if WriteFile(hCommfile,
PChar(PhoneNumber)^,
Length(PhoneNumber),
NumberWrutten,
nil) = false then begin
ShowMessage('Unable to open '+ CommPort);
end;
peocedure Tform1.Button2click(Sender : TObject);
begin
{close the port}
CloseHandle(hCommFile);
end;
●기본 윈도우 폴더들을 가져 오려면?
다음 예는 TMemo 컴포넌트에 기본 쉘 폴더들의 완전한 목록을 가져 오는 것이다.
uses Registry;
procedure TForm1.Button1Click(Sender : TObject);
var
reg : TRegistry;
ts : TStrings;
I : integer;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_CURRENT_USER;
reg.LazyWrite := false;
reg.OpenKey(
'SoftwareMicrosoftwindowsCurrentVersionExplorerSell Folders', false);
ts := TStringList.Create;
reg.GetValueNames(ts);
for I := 0 to ts.Count-1 do begin
Memo1.Lines.Add(ts.Strings[i] + ' = ' +reg.ReadString(ts.Strings[i]));
end;
ts.Free;
reg.CloseKey;
reg.free;
end;
●현재 디스플레이 모드가 지원하는 색들의 수를 찾는 방법은?
다음 방법에서 Display context 의 Color Delth를 찾을 수 있다.
GetDeviceCaps(Form1.Canvas.Handle, BITSPIXEL) *
GetDeviceCaps(Form1.Canvas.Handle, PLANES)
픽셀당 사용된 색의 bit 들의 총수를 가져 온다.
1 = 2 colors bpp
4 = 16 colors bpp
8 = 256 colors bpp
15 = 32768 colors(will return 16 on most drivers) bpp
16 = 65535 colors bpp
24 = 16,777,216 colors bpp
32 = 16,777,216 colors (same as 24) bpp
색상들의 총수를 계산하기 위해서 다음을 사용한다.
NumberOfColors := (1 뇌
(GetDeviceCaps(Form1.Canvas.Handle, BITSPIXEL) *
GetDeviceCaps(Form1.Canvas.Handle, PLANES));
●문자열의 배경을 투명하게 하려면?
윈도우 API 함수인 SetBkMode() 함수를 사용한다.
procedure TForm1.Button1Click(Sender : TObject);
var
OldBkMode : integer;
begin
with Form1.Canvas do begin
Brush.Color := ClRed;
FillRect(Rect(0, 0, 100, 100));
Brush.Color := ClBlue;
TextOut(10, 20, 'Not Transparent!');
OldBkMode := SetBkMode(Handle, TRANSPARENT);
TextOut(10, 50, 'Transparent!');
SetBkMode(Handle, OldBkMode);
end;
end;
●주어진 폴더에서 탐색기 윈도우를 열 수 있나?
다음 예는 Windows 디렉토리의 내용을 포함한 탐색기 윈도우를 여는 것이다.
uses ShellApi;
procedure TForm1.Button1Click(Sender : TObject);
begin
ShellExecute(0, 'explore', 'C:WIDOWS', nil, nil, SW_SHOWNORMAL);
end;
●프로그램의 실행에 대한 인스턴스를 한 개만 가능하도록 할 수 있나? 즉, 한 개 이상의 인스턴스를 시작하려면 이전의 인스턴스를 저장하고 Shut Down 시킬 수 있나?
Win16에서는 HPrevInst를 변수를 시작하기 전에 체크하여 0이 아니면 애플리케이션이 이미 실행중임을 나타내는데, Win32에서는 hPrevInst를 사용할 수 없다. 다음의 예제를 참고하기 바란다.
{The code for OneInstance.dpr}
program OneInstance;
uses
Windows, Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
begin
{Attempt to create a named mutex}
CreateMutex(nil, false, 'MyApp');
{if it failed then there is another instance}
if GetLastError = ERROR_ALREADY_EXISTS then begin
{Send all windows our custom message - only our other}
{instance will recognise it, and restore itself}
SendMessage(HWND_BROADCAST, RegisterWindowMessage('MyApp'), 0 ,0);
{Lets quit}
Halt(0);
end;
Application.Initialize;
{Tell Delphi to un-hide it's hidden application window}
{This allows our instance to have a icon on the task bar}
Application.ShowMainform := true;
ShowWindow(Application.Handle, SW_RESTORE);
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
{The code for unit1.pas}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender : TObject);
procedure FormDestroy(Sender : TObject);
private
{ }
public
{ }
end;
var
Form1 : Tform1;
implemantation
{$R *.DFM}
var
OldWindowProc : Pointer; {Variable for the old windows proc}
MyMsg : DWord; {custom systemwide message}
function NewWindowProc(WindowHandle : hWnd;
TheMessage : LongInt;
ParamW : LongInt;
ParamL : LongInt) : LongInt stdcall;
begin
if TheMessage = MyMsg then begin
{Tell the application to restore, let it restore the form}
SendMessage(Application.handle, WM_SYSCOMMAND, SC_RESTORE, 0);
SetForegroundWindow(Application.Handle);
{We handled the message - we are done}
Result := 0;
exit;
end;
{Call the original winproc}
Result := CallWindowProc(OldWindowProc, WindowHandle, TheMessage, ParamW,
ParamL);
end;
procedure TForm1.FormCreate(Sender : TObject);
begin
{Register a custom windows message}
MyMsg := RegisterWindowMessage('MyApp');
{Set form1's windows proc to ours and remember the old window proc}
OldWindowProc := Pointer(SetWindowLong(Form1.Handle, GWL_WNDPROC,
LongInt(@NewWindowProc)));
end;
procedure TForm1.FormDestory(Sender : TObject);
begin
{Set form1's window proc back to it's original procedure}
SetWindowLong(Form1.Handle, GWL_WNDPROC, LongInt(OldWindowProc));
end;
begin
{Tell Delphi to hide it's hidden application window for now to avoid}
{a "flash" on the taskbar if we halt due to another instance}
ShowWindow(Application.Handle, SW_HIDE);
end.
●응용프로그램에서 Task Switching(Alt-Tab, Ctrl-Esc, Ctrl-Alt-Del)를 막으려면?
응용프로그램에서 스위칭을 저지하는 것은 Screen Saver가 실행중인 것처럼 하여 윈도우에 속임수를 사용함으로써 가능하다.
이 방법은 윈도우 NT에서는 불가능하다.
다음의 코드는 Screen Saver가 실행중인 것처럼 속임수를 쓰는 것이다.
var
OldValue : LongBool;
begin
{turns the trap on}
SystemParametersInfo(97, Word(True), @OldValue, 0);
{turn the trap off}
SystemParametersInfo(97, Word(False), @OldValue, 0);
end;
●TPrinter 유닛을 사용하지 않고 델파이에서 인쇄할 수 있나?
다음 예는 윈도우 API 함수인 PrintDlg()를 사용하는 것으로, 이는 리턴된 dc를 사용하여 프린터를 선택하고 2개페이지를 인쇄하는 것이다.
uses CommDlg;
{$IFDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}
procedure TForm1.Button1Click(Sender : TObject);
var
pd : TPrintDlg;
docInfo : TDocInfo;
begin
FillChar(Pd, sizeof(Pd), #0);
Pd.lStructSize := sizeof(Pd);
Pd.hWndOwner := Form1.Handle;
Pd.Flags := PD_RETURNDC;
if PrintDlg(pd) then begin
FillChar(DocInfo, sizeof(DocInfo), #0);
docInfo.cbSize := Sizeof(DocInfo);
GetMem(DocInfo.lpszDocName, 32);
GetMem(DocInfo.lpszOutput, MAX_PATH);
lStrCpy(DocInfo.lpszDocName, 'My documant');
{Add this line to print to a file}
lStrCpy(DocInfo.lpszOutPut, 'C:DownloadTest.doc');
StartDoc(Pd.hDc, docInfo);
StartPage(Pd.hDc);
TextOut(Pd.hDc, 100, 100, 'Page1', 6);
EndPage(Pd.hDc);
StartPage(Pd.hDc);
TextOut(Pd.hDc, 100, 100, 'Page 2', 6);
EndPage(Pd.hDc);
EndDoc(Pd.hDc);
FreeMem(DocInfo.lpszDocName, 32);
FreeMem(DocInfo.lpszOutput, MAX_PATH);
end;
end;
●응용프로그램이 Custom Print Driver를 사용한다면, 사용자의 개입 없이 윈도우 3.1이나 윈도우 95에서 프린터 드라이버를 설치하는 것이 가능한가?
다음 예는 프린터 드라이버를 설치하는 것이다. WindowsSystem 디렉토리에 프린트 드라이버 파일들을 복사하고, Win.ini 파일에 다음 값들을 추가해야 한다.
procedure TForm1.Button1Click(Sender : TObject);
var
s : array[0..64] of char;
begin
WriteProfileString('PrinterPorts', 'DriverName', 'DRVFILE,FILE : ,15,45');
WriteProfileString('Devices', 'DriverName', 'DRVFILE,FILE : ');
StrCopy(S, 'PrinterPorts');
SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@S));
StrCopy(S, 'Devices');
SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@S));
end;
●프로그램에서 다른 응용프로그램을 종료시키려면?
WM_QUIT 메시지를 응용프로그램에 보내면 된다.
PostMessage(FindWindow(Nil, 'window caption'), WM_QUIT, 0, 0);
Window Caption에 메시지를 보낼 윈도우의 Caption이 들어가야 한다.
●Windows Desktop 아이콘들을 Refresh하려면?
다음 예는 Windows Desktop 아이콘들을 Refresh하는 것이다.
procedure TForm1.Button1Click(Sender : TObject);
begin
SendMessage(FindWindow('Program', 'Program Manager'), WM_COMMAND, $A065,
0);
end;
●폼의 Caption Bar를 없애려면?
폼의 스타일과 높이를 재설정한다.
procedure TForm1.formCreate(Sender : TObject);
begin
SetWindowLong(Form1.Handle, GWL_STYLE,
GetWindowLong(Handle,GWL_STYLE) and not WS_CAPTION);
Height := ClientHeight;
end;
●응용프로그램에 전달되는 명령 라인으로부터 스페이스를 포함하는 긴 파일 이름을 가져 오려면?
윈도우 API 함수인 GetCommandLine()은 응용프로그램에 완전한 명령 라인을 제공한다.
procedure TForm1.Button1Click(Sender : TObject);
var
s : string;
begin
s := GetCommandLine;
Delete(s, 1, pos('exe"', s) + 4);
Memo1.Lines.Add(s);
end;
●Windows의 32bit 버전에서 사용자의 로그인 이름을 가져 오려면?
윈도우 API 함수인 GetuserName()을 호출함으로써 가능하다.
procedure TForm1.Button1Click(Sender : TObject);
var
buffer : array[0..255] of char;
buffSize : DWORD;
begin
buffSize := sizeof(buffer);
GetUserName(@buffer, buffSize);
ShowMessage(buffer);
end;
char 배열을 사용한 메모리는 응용프로그램이 종료될 때 까지 free될 것이다.
이처럼 Long String를 사용할 수 있다.
procedure TForm1.button2Click(Sender : TObject);
var
buffer : string;
buffSize : DWORD;
begin
buffSize := 128;
SetLength(buffer, BuffSize);
GetUserName(pChar(buffer), buffSize);
ShowMessage(buffer);
end;
Long String을 사용한 메모리는 스코프가 끝날 때 해제된다.
●주어진 확장자를 가지는 프로그램들을 가져 오려면?
다음 예는 파일 확장자를 가진 연결된 파일들 가져 오는 예이다.
uses
{$IFDEF WIN32}
Registry; {We will get it from the registry}
{$ELSE}
IniFiles; {We will get it from the win.ini file}
{$ENDIF}
{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}
function GetProgramAssociation(Ext : string) : string;
var
{$IFDEF WIN32}
reg : TRegistry;
s : string;
{$ELSE}
WinIni : TIniFile;
WinIniFileName : array[0..MAX_PATH] of char;
s : string;
{$ENFIF}
begin
{$IFDEF WIN32}
s := '';
reg := TRegistry.Create;
reg.RootKey := HKEY_CLASSES_ROOOT;
if reg.OpenKey('.' + ext + 'shellopencommand', false) <> false then begin
{The Open command has been found}
s := reg.ReadString('');
reg.CloseKey;
end else begin
{perhaps thier is a system file pointer}
if reg.OpenKey('.'+ext, false) <> false then begin
s := reg.ReadString('');
reg.CloseKey;
if s <> '' then begin
{A system file pointer was found}
if reg.OpenKey(s + 'shellopencommand', false) <> false then
{The Open command has been found}
s := reg.ReadString('');
reg.CloseKey;
end;
end;
end;
{Delete any command kine, quotes and spaces}
if Pos('%', s) > 0 then
Delete(s, Pos('%', s), length(s));
if ((length(s) > 0) and (s[1] = '"')) then
Delete(s, 1, 1);
if ((length(s) > 0) and (s[length(s)] = '"')) then
Delete(s, Length(s), 1);
while ((Length(s) > 0) and ((s[length(s)] = #32) or (s[Length(s)] = '"'))) do
Delete(s, Length(s), 1);
{$ELSE}
GetWindowsDirectory(WinIniFileName, sizeof(WinInifileName));
StrCat(WinIniFileName, 'win.ini');
WinIni := TIniFile.Create(WinIniFileName);
s := WinIni.ReadString('Extensions', ext, '');
WinIni.Free;
{Delete any command line}
if Pos(' ^', s) > 0 then
Delete(s, Pos(' ^', s), length(s));
{$ENDIF}
result := s;
end;
procedure TForm1.Button1click(Sender : TObject);
begin
ShowMessage(GetProgramAssociation('gif'));
end;
●윈도우가 시작될 때마다 응용프로그램이 시작되도록 하려면?
다음은 Windows 부트 시퀸스에 응용프로그램을 추가하는 것이다. 다음 코드는 Win32와 Win16 플랫폼에서 모두 가능하다.
uses
Registry, {For Win32}
IniFiles; {For Win16}
{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}
{For Win32}
procedure TForm1.Button1Click(Sender : TObject);
var
reg : TRegistry;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACJINE;
reg.LazyWrite := false;
reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionRun', false);
reg.WriteString('My App', Application.ExeName);
reg.CloseKey;
reg.free;
end;
{for Win16}
procedure TForm1.Button2click(Sender : TObject);
var
WinIni : TIniFile;
WinIniFileName : array[0..MAX_PATH] of char;
s : string;
begin
GetWindowsDirectory(WinIniFileName, sizeof(WininiFileName));
StrCat(WinIniFileName, 'win.ini');
WinIni := TIniFile.Create(WinIniFileName);
s := Winini.ReadString('windows', 'run', '');
if s = '' then
s := Application.ExeName else
s := s + ';'+ Application.ExeName;
WinIni.WriteString('windows', 'run', s);
WinIni.Free;
end;
'Delphi' 카테고리의 다른 글
| 날짜/시간형식 변경 및 강제 시간세팅 (0) | 2014.02.13 |
|---|---|
| Q&A 정리 (0) | 2014.02.13 |
| Tip 정리 (0) | 2014.02.13 |
| 올림 / 내림(버림) (0) | 2011.08.03 |
| 델파이의 소숫점 반올림 방식 (2) | 2011.08.03 |
Prev
Rss Feed