Delphi Tip 03

How do I execute a program and have my code wait until it is finished?

//-------A: Here is the 16 bit version:

uses Wintypes,WinProcs,Toolhelp,Classes,Forms;

Function WinExecAndWait(Path : string; Visibility : word) : word;
var
    InstanceID : THandle;
    PathLen : integer;

begin
    { inplace conversion of a String to a PChar }
    PathLen := Length(Path);
    Move(Path[1],Path[0],PathLen);
    Path[PathLen] := #00;
    { Try to run the application }
    InstanceID := WinExec(@Path,Visibility);
    if InstanceID< 32 then    { a value less than 32 indicates an Exec error }
    WinExecAndWait := InstanceID

else begin
    Repeat
       Application.ProcessMessages;
    until Application.Terminated or (GetModuleUsage(InstanceID) = 0);

    WinExecAndWait := 32;
end;

end;

//--------- Here is the 32 bit version:

function WinExecAndWait32(FileName:String; Visibility : integer):integer;
var
    zAppName:array[0..512] of char;
    zCurDir:array[0..255] of char;
    WorkDir:String;
    StartupInfo:TStartupInfo;
    ProcessInfo:TProcessInformation;

begin
    StrPCopy(zAppName,FileName);
    GetDir(0,WorkDir);
    StrPCopy(zCurDir,WorkDir);
    FillChar(StartupInfo,Sizeof(StartupInfo),#0);
    StartupInfo.cb := Sizeof(StartupInfo);

    StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
    StartupInfo.wShowWindow := Visibility;
    if not CreateProcess(nil,
       zAppName,   { pointer to command line string }
       nil,                { pointer to process security attributes }
       nil,                { pointer to thread security attributes }
       false,            { handle inheritance flag }
       CREATE_NEW_CONSOLE or   { creation flags }
       NORMAL_PRIORITY_CLASS,
       nil,                { pointer to new environment block }
       nil,                { pointer to current directory name }
       StartupInfo, { pointer to STARTUPINFO }
       ProcessInfo) then Result := -1    { pointer to PROCESS_INF }

    else begin
       WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
       GetExitCodeProcess(ProcessInfo.hProcess,Result);
    end;
end;

<문자열 대.소문자로 바꾸기>

EDITBOX 같은데서 키보드 입력 제한을 할때 영문(대.소문자)를 가리기 위해 대부분이 keypress 나 keyup 또는 keydown EVENT에서 처리 하는 것으로 알고 있습니다.

좀 뭐랄까 ??? 약간 무식한 방법이였지요.... 소스코드도 지저분해 지고.......

EditChange Event에서 다음과 같은 방법을 권합니다.

procedure _MYForm.WoonoEdit1Change(Sender : TObject);
begin
WoonoEdit1.CharCase := clLowerCase;
// 입력 받을때 무조건 영문 소문자로 받는다.
end;

ecLowerCase : 모든 영문자를 소문자로 받는다.
ecUpperCase : 모든 영문자를 대문자로 받는다.
ecNormal : 모든 영문자를 보통 상태로 유지한다.

<파일정보(생성,변경,접근일자,속성,종류...)>

아래 소스는 파일의 각종 정보를 읽어오는 루틴인데 완전히 모듈화가 된 것은 아니지만, 파일의 생성,변경,접근일자를 읽는 부분이 있어 올립니다

  function FileSize(hi,lo: integer) :longint;
  begin
    Result := (hi * MAXDWORD) + lo;
  end;

  // This function retrieves the last time, the given file was written to disk
function GetLocalTime(a:tfiletime):string;

var
      mtm:   TSystemTime;
      at:    TFileTime;
      ds,ts: ShortString;

begin
      filetimetolocalfiletime(a,at);
      filetimetosystemtime(at,mtm);
      SetLength(ds, GetDateFormat(LOCALE_USER_DEFAULT, 0, @mtm, NIL, @ds[1], 255) - 1);
      SetLength(ts, GetTimeFormat(LOCALE_USER_DEFAULT, time_noseconds, @mtm, NIL,
            @ts[1], 255) - 1);
      Result:=ds+' '+ts;
end;

procedure TFileInfoForm.GetFileInfo(FileName: String);

var
    SHFinfo: TSHFileInfo;
    FindData: TWin32FindData;    FindHandle :THandle;

begin
    L_FileName.Caption := ExtractFileName(FileName); // 파일명(Name)
    ShGetFileInfo(PChar(FileName), 0, SHFinfo, SizeOf(SHFinfo), // 파일종류만 알아낸다
                  SHGFI_TYPENAME);
    L_Filetype.Caption := SHFinfo.szTypeName; // 파일종류(Type)
    FindHandle := Windows.FindFirstFile(PChar(FileName), FindData);

    try
      L_Filesize.Caption := FloatToStr(Trunc(FileSize(FindData.nFileSizeHigh,
         FindData.nFileSizeLow) / 1024))+' KB ('+ IntToStr(FileSize(FindData.nFileSizeHigh,
         FindData.nFileSizeLow))+' Bytes)';

      OldAttributes := FileGetAttr(FileName); // 파일의 속성(attribute)
      CB_ReadOnly.Checked := (OldAttributes and faReadOnly) = faReadOnly;
      CB_Archive.Checked := (OldAttributes and faArchive) = faArchive;
      CB_System.Checked   := (OldAttributes and faSysFile) = faSysFile;
      CB_Hidden.Checked   := (OldAttributes and faHidden) = faHidden;
       L_Created.Caption    := GetLocalTime(FindData.ftCreationTime);   // 파일생성일(Created)
      L_Modified.Caption   := GetLocalTime(FindData.ftLastWriteTime); // 파일변경일(Modified)
      L_LastAccess.Caption := GetLocalTime(FindData.ftLastAccessTime);
      // 파일접근일(LastAccess)

    finally
      Windows.FindClose(FindHandle);
    end;
end;

<JPEG 파일 처리>

우선 uses 에 JPEG 를 추가한다.

procedure TForm1.Button1Click(Sender : TObjcect);
var
   TempImg : TImage;
   Jpg : TJPEGImage;
begin
   TempImg:=TImage.Create(Self);
   with TempImg do   begin
      Width:=PaintBox1.Width;
      TempImg.Height:=PaintBox1.Height;
   end;
   Jpg:=TJPEGImage.Create;
   with PaintBox1 do begin
      BitBlt(TempImg.Canvas.Handle,0,0,Width,Height,Canvas.Handle,0,0,SrcCopy);
   end;
   TempImg.Picture.Bitmap.SaveToFile('TempImg.bmp');
   Jpg.Assign(TempImg.Picture.Bitmap);
     //Bitmap File을 Jpeg파일로
   Jpg.SaveToFile('TestImg.jpg');
   TempImg.Free;
   Jpg.Free;
end;

다른 방법(함수 이용 - 천리안 류님께서 올린 함수)
* Source

Implementation
uses
   JPeg;

procedure LoadJPeg(FileName:String; PicIn:TPicture);
var
   JPegImage : TJPegImage;
begin
   JPegImage:= TJPegImage.Create;
   JPegImage.LoadFromFile(FileName);
   PicIn.Assign(JPegImage);
   JPegImage.Free;
end;

procedure TForm1.Button1Click(Sender : TObject);
begin
  if OpenDialog1.Execute then
     LoadJPeg(OpenDialog1.Filename, Image1.Picture);
      //JPEG파일을 로드하여 Image1에 보여줌
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   OldBkMode : integer;
begin
   Image1.Picture.Bitmap.Canvas.Font.Color := clRed;
   OldBkMode := SetBkMode(Image1.Picture.Bitmap.Canvas.Handle, TRANSPARENT);
   Image1.Picture.Bitmap.Canvas.TextOut(10, 10, 'Hi, I am Park');
   SetBkMode(Image1.Picture.Bitmap.Canvas.Handle, OldBkMode);
end;

<파일의 날짜와 시간을 알아내기>

아래 함수를 이용합니다.
function GetFileDate(TheFileName: string): string;
var
   FHandle: integer;
begin
   FHandle := FileOpen(TheFileName, 0);
   try
      Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));
   finally
      FileClose(FHandle);
   end;
end;

<드라이브에 디스크 존재여부 알아내기>

function DriveReady(Drive : char):Boolean;
var
   OldErrorMode : word;
   OldDir : string;
begin
   OldErrorMode:= SetErrorMode(SEM_NOOPENFILEERRORBOX);
   GetDir(0, OldDir);
   Result:= True;
   try
      ChDir(Drive + ':\');
   except
      Result:= False
   end;
   ChDir(OldDir);
   SetErrorMode(OldErrorMode);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if DriveReady('A') then ShowMessage('Drive is Ready')
   else ShowMessage('Drive not Ready');
end;

<화면 캡쳐하여 저장하기>

procedure TForm1.Button1Click(Sender: TObject);
var
   DeskTop : TCanvas ;
begin
   DeskTop := TCanvas.Create ;
   try
   with DeskTop do
      Handle := GetWindowDC (GetDesktopWindow) ;
   with PaintBox1.Canvas do
   CopyRect (Rect (0, 0, Width, Height),   DeskTop, Rect (0, 0, Width, Width))
   finally
      DeskTop.Free
   end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
   MyBmp: TBitmap;
begin
   MyBmp := TBitmap.Create;
   with MyBmp do begin
     Height := PaintBox1.Height;
     Width := PaintBox1.Width;
     Canvas.CopyRect (Rect (0, 0, Width, Height), PaintBox1.Canvas, Rect (0, 0, Width, Height));
     SaveToFile('c:\Grim.bmp');
   end;
      MyBmp.Free;
end;

<텍스트 문서 미리보기>

솔직히 미리보기라기 보다는 텍스트 파일의 내용을 Bitmap파일로 변환하여 저장합니다.
procedure TForm1.Button1Click(Sender: TObject);
var
   Bmp : TBitmap;
   Line : string;
   I : integer;
   ch : char;
   F : TextFile;
begin
   I := 0;
   Bmp := TBitmap.Create;
   with Bmp do begin
      Width := ClientRect.Right;
      Height := ClientRect.Bottom;
      AssignFile(F, 'c:\mytext.txt'); {저장하고자 하는 파일명을 삽입}
      Reset(F);
      repeat
        Inc(I);
        Line := '';
        repeat
          Read(F, ch);
          Line := Line+ch;
       until ch= #10;
       Canvas.TextOut(10, I*20, Copy(Line, 1, Length(Line)-2));
      until EOF(F);
   CloseFile(F);
   BitBlt(Canvas.Handle, 0, 0, Width, Height, GetDc(Handle),  ClientRect.Left, ClientRect.Top, SRCCOPY);
   SaveToFile('c:\preview.bmp');
   Free;
   end;
end;

<폼의 크기 제한하기>

폼의 크기를 조절할 때 최대, 최소의 크기제한을 두려면
"WM_GETMINMAXINFO"의 메시지 핸들러를 작성해야 한다.
type
   TForm1 = class(TForm)
     procedure FormCreate(Sender: TObjcet);

   private
     MinSize : TPoint;       //최소크기 제한
     MaxSize : TPoint;      //최대크기 제한
     procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
     message WM_GETMINMAXINFO;
     //메시지 WM_GETMINMAXINFO에 반응하는 메소드

   public
end;

procedure TForm1.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
begin
   if visible then begin
   Msg.MinMaxInfo^.PtMinTrackSize := MinSize;
   Msg.MinMaxInfo^.PtMaxTrackSize := MaxSize;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject); //최대,최소 사이즈 지정
begin
   MaxSize.X := 200;
   MaxSize.Y := 500;
   MinSize.X := 100;
   MinSize.Y := 200;
end;

<마우스 동작범위 제한하기>

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
   R : TRect;
begin
   R := BoundsRect;
   InflateRect(R,-30,-30);
   ClipCursor(@R);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
   ClipCursor(Nil);
end;

<스플레시 화면 만들기>

프로그램 시작시 나타나는 로고화면을 제작하는 방법이다. 이는 프로젝트파일(.dpr)를 직접
수정해야만 한다.
Project Option에서 SplashForm을 Available forms로 옮긴다.
program project1;

uses
   Forms,
   Unit1 in 'Unit1.pas' {Form1},
   Splash in 'Splash.pas' {SplashForm},

{$R *.RES}
begin
  SplashForm := TSplashForm.Create(Application);
  SplashForm.Show;
  SplashForm.Update;
  Application.CreateForm(TForm1, Form1);
  SplashForm.Hide;
  SplashForm.Free;
   Application.Run;
end.

<구멍난 폼 만들기>

하나의 폼 위에 다섯개의 판넬을 올려놓고 각각의 속성을 아래의 '표1' 과 같이 설정하고,
폼의 OnResize이벤트 헨들러를 생성 해 아래의 코드를 입력하자.

procedure TForm1.FormResize(Sender: TObject);
var
   WindowRgn, HoleRgn : HRgn;
begin
   WindowRgn := 0;
   GetWindowRgn(Handle, WindowRgn);
   DeleteObject(WindowRgn);
   WindowRgn := CreateRectRgn(0,0,Width, Height);
   HoleRgn := CreateRectRgn(Panel3.Width + 6, Panel1.Height + 25,
                   Width - (Panel4.Width + 6), Height - (Panel2.Height + 6));
   CombineRgn(WindowRgn, WindowRgn, HoleRgn, RGN_DIFF);
   SetWindowRgn(Handle, WindowRgn, TRUE);
   DeleteObject(HoleRgn);
end;

표1
---------------------------------
Panel1
---------------------------------
Align alTop
BevelOuter bvNone
Caption
Height 17
---------------------------------
Panel2
---------------------------------
Align alBottom
BevelOuter bvNone
Caption
Height 17
---------------------------------
Panel3
---------------------------------
Align alRight
BevelOuter bvNone
Caption
Width 17
---------------------------------
Panel4
---------------------------------
Align alRight
BevelOuter bvNone
Caption
Width 17
---------------------------------
Panel5
---------------------------------
Align alClient
BevelOuter bvLowered
Caption
---------------------------------

<원형 폼 만들기>

procedure TForm1.FormCreate(Sender : TObjcet);
var
   MyForm : HRGN;
begin
   MyForm := CreateEllipticRgn(0, 0, Width, Height); //타원의 폼 설정
   SetWindowRgn(Handle, MyForm, TRUE);
end;
procedure TForm1.FormDestory(Sender : TObject);
begin
   DeleteObject(MyForm);
end;

<다각형의 폼 만들기>

다각형의 폼도 마찬가지로 CreatepolygonRgn함수를 사용해 만들 수 있다.
아래와 같이 하면 역삼각형의 폼이 만들어진다.
procedure TForm1.FormCreate(Sender : TObject);
var
   MyForm : HRGN;
   Pixel : array[0..2] of TPoint;
begin
   Pixel[0] := Point(0, 0);        //폼의 좌표를 설정
   Pixel[1] := Point(Width, 0);
   Pixel[2] := Point(Width div 2, Height);
   MyForm := CreatePolygonRgn(Pixel, 3, ALTERNATE);
   SetWindowRgn(Handle, MyForm, TRUE);
end;

<힌트의 속성바꾸기>

델파이에서는 힌트속성을 쉽게 구현할 수 있는 반면 힌트의 속성을 바꿀 수 있는 프로퍼티가 없습니다.
아래의 방법을 통해 속성을 바꿔보세요.
....
type
  TUserHint = class(THintWindow)
  constructor Create(AOwner: TComponent); override;
end;                                         //interface부에 삽입
...
constructor TUserHint.Create;
begin
   inherited Create(AOwner);
   Canvas.Font.Name := '궁서체';    // 원하는 폰트의 이름 지정
   Canvas.Font.Size := 10;              // 원하는 폰트의 사이즈 지정
   Canvas.Brush.Color := clYellow; // 원하는 바탕색 지정
end;                                             // implementation부에 삽입

procedure TForm1.FormCreate(Sender: TObjcet);
var
   OldHint : Boolean;
begin
   OldHint := Application.ShowHint;
   Application.ShowHint := False;
   HintWindowClass := TUserHint;
   Application.ShowHint := OldHint;
end;
end.

<상태바에 힌트보이기>

public
{ Public declarations }
   procedure ShowHint(Sender : TObject); //힌트를 보이기위한 프로시저
end;

procedure TForm1.ShowHint(Sender : TObject);
begin
    StatusBar1.Panels[0].Text := Application.Hint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    Application.HintPause := 100; //힌트가 나타나는 속도조절
    Application.OnHint := ShowHint;
end;
또한 힌트와 상태바에 동시에 힌트를 나타내고자 하는 경우에는 Hint속성을 '|'문자를 끊어서
동시에 지정할 수 있다. ("풍선도움말|OnHint이벤트에서 사용할 힌트")

<Drive Type을 알아내자>

임의의 드라이브 타입을 알려면, 윈도우 API 함수 중 GetDriveType이라는 함수를 사용하면 된다.

procedure TForm1.Button1Click(Sender: TObject);

var
   Drive: Char;
   DriveLetter: String[4];

begin
   for Drive := 'A' to 'Z' do
   begin
      DriveLetter := Drive + ':\';
      // Syntax
      // GetDriveType(
      // lpRootPathName: PChar   {a pointer to the root path string}
      // ): UINT;                 {returns a value based on the drive type}

      case GetDriveType(PChar(Drive + ':\')) of
         Drive_UnKnown : ListBox1.Items.Add( DriveLetter + ' : 알 수 없는 드라이브');
         Drive_Removable: ListBox1.Items.Add( DriveLetter + ' : 플로피 드라이브');
         Drive_Fixed:      ListBox1.Items.Add( DriveLetter + ' : 하드 드라이브');
         Drive_Remote:    ListBox1.Items.Add( DriveLetter + ' : 네트워크 드라이브');
         Drive_Cdrom:     ListBox1.Items.Add( DriveLetter + ' : CD-Rom 드라이브');
         Drive_RamDisk:   ListBox1.Items.Add( DriveLetter + ' : RamDisk 드라이브');
      end;
   end;
end;