저작권에 대한 공지

이 문서에 포함된 모든 글과 소스 코드는 작자인 저 김성동의 지적 재산이지만 무단으로 배포하거나 책이나 강의 교재등을 위한 복제 등 저작권을 저해하는 행위를 제외하고는 자유롭게 사용할 수 있습니다.
또한 이 페이지에 대한 링크는 자유롭게 할 수 있으나 전문을 전제하는 일은 허용하지 않습니다.

2.3. 3차원 레이블 콤포넌트 개발

델파이에 기본적으로 포함되어 있는 기본 콤포넌트인 밋밋한 TLabel 콤포넌트의 기능을 확장해서 폼을 좀 더 화려하게 구성할 때 사용할 수 있는 3차원 효과를 가지는 Label 콤포넌트를 만들어 보자. 또한 국내 업무용 프로그램의 경우 Panel이나 Bevel 콤포넌트를 써서 필드의 이름을 강조하는 경우가 종종 있는데 Panel을 사용한다면 윈도 리소스를 많이 소모하게 되므로 Label 콤포넌트 자체적으로 외곽선을 그려주도록 해서 간편하게 사용할 수 있도록 만들어 보자. 완성된 콤포넌트는 아래 그림과 같이 동작한다.

그림 2-11 TdpbLabel 콤포넌트 동작 화면

그리고 완성된 콤포넌트의 소스는 아래 리스트와 같다.

리스트 2.4 dpbLabel.pas

unit dpbLabel;

interface

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

type
  { 그려야 할 외곽선 }
  TdpbEdges = set of ( deLeft, deTop, deRight, deBottom );

  { 외곽선 모양 }
  TdpbEdgeStyle = ( desNone, desFlat, desRaised, desRaisedHeavy, desSunken,
                    desSunkenHeavy , desBump, desEtched );

  { 텍스트 모양 }
  TdpbTextStyle = ( dtsFlat, dtsRaised, dtsRaisedHeavy, dtsSunken,
                    dtsSunkenHeavy, dtsShadow );

  { 그림자 효과 방향 }
  TdpbShadowDirection = ( dsdTopLeft, dsdTopRight, dsdBottomLeft, dsdBottomRight );

  TdpbLabel = class(TCustomLabel)
  private
    { Private declarations }
    FEdges : TdpbEdges;
    FEdgeStyle : TdpbEdgeStyle;
    FTextStyle : TdpbTextStyle;
    { 그림자 방향 }
    FShadowDirection : TdpbShadowDirection;
    { 그림자 색 }
    FShadowColor : TColor;
    { 그림자 깊이 }
    FShadowDepth : Integer;

    procedure SetEdges(const Value: TdpbEdges);
    procedure SetEdgeStyle(const Value: TdpbEdgeStyle);
    procedure SetShadowDepth(const Value: Integer);
    procedure SetShadowDirection(const Value: TdpbShadowDirection);
    procedure SetTextStyle(const Value: TdpbTextStyle);
    procedure SetShadowColor(const Value: TColor);
  protected
    { Protected declarations }
    procedure DoDrawEdge(ACanvas : TCanvas; var ARect : TRect);
    procedure DoDrawCaption(ACanvas : TCanvas; ARect : TRect);
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    procedure Paint; override;
  published
    { Published declarations }
    property Anchors;
    property Align;
    property Alignment;
    property AutoSize;
    property Caption;
    property Color;
    property Cursor;
    property DragCursor;
    property DragMode;

    property Edges : TdpbEdges
             read FEdges
             write SetEdges
             default [deLeft, deTop, deRight, deBottom];

    property EdgeStyle : TdpbEdgeStyle
             read FEdgeStyle
             write SetEdgeStyle
             default desNone;

    property FocusControl;
    property Font;
    property Hint;
    property Layout;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;

    property ShadowColor : TColor
             read FShadowColor
             write SetShadowColor
             default clBtnShadow;

    property ShadowDirection : TdpbShadowDirection
             read FShadowDirection
             write SetShadowDirection
             default dsdBottomRight;

    property ShadowDepth : Integer
             read FShadowDepth
             write SetShadowDepth
             default 1;

    property ShowAccelChar;
    property ShowHint;

    property TextStyle : TdpbTextStyle
             read FTextStyle
             write SetTextStyle
             default dtsFlat;

    property Transparent;
    property WordWrap;

    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('DPB', [TdpbLabel]);
end;

{ TdpbLabel }

constructor TdpbLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEdges := [deLeft, deTop, deRight, deBottom];
  FEdgeStyle := desNone;
  FTextStyle := dtsFlat;
  FShadowDirection := dsdBottomRight;
  FShadowDepth := 1;
  FShadowColor := clBtnShadow;
end;

procedure TdpbLabel.DoDrawCaption(ACanvas: TCanvas; ARect: TRect);
const
  Alignments: array[TAlignment] of WORD = (DT_LEFT, DT_RIGHT, DT_CENTER);
  WordWraps: array[Boolean] of WORD = (0, DT_WORDBREAK);
  ShowAccel : array[Boolean] of WORD = (DT_NOPREFIX, 0);
var
  TextFlag : WORD;
  rDraw, rExtent : TRect;
  TE : TSize;
begin
  with ACanvas do
  begin
    rExtent := ARect;
    Font.Assign(Self.Font);
    Brush.Style := bsClear;
    TextFlag := DT_EXPANDTABS Or WordWraps[WordWrap] Or
                ShowAccel[ShowAccelChar] or Alignments[Alignment];
    DrawText(Handle, PChar(Caption), -1, rExtent, TextFlag Or DT_CALCRECT);
    TE.CX := rExtent.Right - rExtent.Left;
    TE.CY := rExtent.Bottom - rExtent.Top;
    rDraw := ARect;
    case Layout of
      tlCenter :
        rDraw.Top := rDraw.Top + ((rDraw.Bottom - rDraw.Top) - 
(rExtent.Bottom - rExtent.Top)) div 2;
      tlBottom :
        rDraw.Top := rDraw.Top + ((rDraw.Bottom - rDraw.Top) - 
(rExtent.Bottom - rExtent.Top));
    end;

    case FTextStyle of
      dtsFlat :
        begin
          DrawText(Handle, PChar(Caption), -1, rDraw, TextFlag);
        end;
      dtsRaised :
        begin
          OffsetRect(rDraw, -1, -1);
          Font.Color := clBtnHighlight;
          DrawText(Handle, PChar(Caption), -1, rDraw, TextFlag);
          OffsetRect(rDraw, 1, 1);
          Font.Color := Self.Font.Color;
          DrawText(Handle, PChar(Caption), -1, rDraw, TextFlag);
        end;
      dtsRaisedHeavy :
        begin
          OffsetRect(rDraw, -1, -1);
          Font.Color := clBtnHighlight;
          DrawText(Handle, PChar(Caption), -1, rDraw, TextFlag);
          OffsetRect(rDraw, 2, 2);
          Font.Color := FShadowColor;
          DrawText(Handle, PChar(Caption), -1, rDraw, TextFlag);
          OffsetRect(rDraw, -1, -1);
          Font.Color := Self.Font.Color;
          DrawText(Handle, PChar(Caption), -1, rDraw, TextFlag);
        end;
      dtsSunken :
        begin
          OffsetRect(rDraw, 1, 1);
          Font.Color := clBtnHighlight;
          DrawText(Handle, PChar(Caption), -1, rDraw, TextFlag);
          OffsetRect(rDraw, -1, -1);
          Font.Color := Self.Font.Color;
          DrawText(Handle, PChar(Caption), -1, rDraw, TextFlag);
        end;
      dtsSunkenHeavy :
        begin
          OffsetRect(rDraw, -1, -1);
          Font.Color := FShadowColor;
          DrawText(Handle, PChar(Caption), -1, rDraw, TextFlag);
          OffsetRect(rDraw, 2, 2);
          Font.Color := clBtnHighlight;
          DrawText(Handle, PChar(Caption), -1, rDraw, TextFlag);
          OffsetRect(rDraw, -1, -1);
          Font.Color := Self.Font.Color;
          DrawText(Handle, PChar(Caption), -1, rDraw, TextFlag);
        end;
      dtsShadow :
        begin
          rExtent := rDraw;
          Case FShadowDirection Of
            dsdTopLeft :
            begin
              OffsetRect(rExtent, -FShadowDepth, -FShadowDepth);
            end;
            dsdTopRight :
            begin
              OffsetRect(rExtent, FShadowDepth, -FShadowDepth);
            end;
            dsdBottomLeft :
            begin
              OffsetRect(rExtent, -FShadowDepth, FShadowDepth);
            end;
            dsdBottomRight :
            begin
              OffsetRect(rExtent, FShadowDepth, FShadowDepth);
            end;
          end;
          Font.Color := FShadowColor;
          DrawText(Handle, PChar(Caption), -1, rExtent, TextFlag);
          Font.Color := Self.Font.Color;
          DrawText(Handle, PChar(Caption), -1, rDraw, TextFlag);
        end;
    end;
    Brush.Style := bsSolid;
  end;
end;

procedure TdpbLabel.DoDrawEdge(ACanvas: TCanvas; var ARect: TRect);
const
  ST : array[TdpbEdgeStyle] of WORD = (0,
       BDR_RAISEDOUTER, BDR_RAISEDOUTER, EDGE_RAISED, BDR_SUNKENOUTER,
       EDGE_SUNKEN, EDGE_BUMP, EDGE_ETCHED);
var
  Edge : WORD;
begin
  if FEdgeStyle <> desNone then
  begin
    Edge := 0;
    if deLeft in FEdges then Edge := Edge or BF_LEFT;
    if deTop in FEdges then Edge := Edge or BF_TOP;
    if deRight in FEdges then Edge := Edge or BF_RIGHT;
    if deBottom in FEdges then Edge := Edge or BF_BOTTOM;
    if FEdgeStyle = desFlat then Edge := Edge or BF_FLAT;
    DrawEdge(ACanvas.Handle, ARect, ST[FEdgeStyle], Edge or BF_ADJUST);
  end;
end;

procedure TdpbLabel.Paint;
var
  rClient : TRect;
begin
  with Canvas do
  begin
    rClient := GetClientRect;
    if not Transparent then
    begin
      Brush.Color := Self.Color;
      FillRect(rClient);
    end;
    DoDrawEdge(Canvas, rClient);
    DoDrawCaption(Canvas, rClient);
  end;
end;

procedure TdpbLabel.SetEdges(const Value: TdpbEdges);
begin
  if FEdges <> Value then
  begin
    FEdges := Value;
    Invalidate;
  end;
end;

procedure TdpbLabel.SetEdgeStyle(const Value: TdpbEdgeStyle);
begin
  if FEdgeStyle <> Value then
  begin
    FEdgeStyle := Value;
    Invalidate;
  end;
end;

procedure TdpbLabel.SetShadowColor(const Value: TColor);
begin
  if FShadowColor <> Value then
  begin
    FShadowColor := Value;
    Invalidate;
  end;
end;

procedure TdpbLabel.SetShadowDepth(const Value: Integer);
begin
  if FShadowDepth <> Value then
  begin
    FShadowDepth := Value;
    Invalidate;
  end;
end;

procedure TdpbLabel.SetShadowDirection(const Value: TdpbShadowDirection);
begin
  if FShadowDirection <> Value then
  begin
    FShadowDirection := Value;
    Invalidate;
  end;
end;

procedure TdpbLabel.SetTextStyle(const Value: TdpbTextStyle);
begin
  if FTextStyle <> Value then
  begin
    FTextStyle := Value;
    Invalidate;
  end;
end;

end.

2.3.1. 3차원 효과

Label 콤포넌트의 캡션을 3차원으로 그리는 데 필요한 정보를 가질 프로퍼티로 ShadowColor, ShadowDepth, ShadowDirection, TextStyle 이렇게 4개의 프로퍼티를 만들었다. ShadowDepth, ShadowDirection은 모두 TextStyle 프로퍼티가 dtsShadow일 때만 사용한다. ShadowColor는 그림자 효과를 나타낼 색을 지정하며 ShadowDepth는 그림자 효과를 그릴 깊이를 나타낸다. ShadowDirection은 그림자 효과가 나타날 방향을 설정하는 프로퍼티다. ShadowDirection과 TextStyle은 열거형 프로퍼티로 선언되었다.
다음에 콤포넌트의 외곽선을 그리기 위해서 Edges 라는 집합형 프로퍼티와 EdgeStyle이라는 열거형 프로퍼티를 만들었다. Edges 프로퍼티는 사각형에서 선택된 Edge만 외곽선을 그리도록 설정하는 데 사용하며 EdgeStyle은 외곽선에 3차원 효과를 주기 위해서 사용한다.

2.3.2. 그리기

실제로 그림을 그리는 루틴은 Paint 메소드를 오버라이드해서 작성한다. TCustomLabel의 Paint 메소드를 보면 마지막에 DoDrawText 프로시저를 호출하는 것을 볼 수 있는데 TCustomLabel에서 실제로 캡션을 출력하는 루틴은 바로 이 DoDrawText라는 것을 알 수 있다. 그렇다면 우리가 만들 TdpbLabel에서 DoDrawText를 오버라이드 해서 그려 주면 되겠다라고 생각되지만 안타깝게도 DoDrawText는 가상 메소드도 아니고 더군다나 private 영역에 선언되어 있다. 따라서 부득이 Paint 메소드를 오버라이드 해서 그림을 그려 줄 수 밖에 없다. 콤포넌트를 개발할 때 부모 클래스의 소스 코드가 있다면 부모 클래스에 내가 정의하려고 하는 기능이 없는지 잘 살펴보고 어떤 식으로 구현하는 것이 훨씬 효과적일지 잘 생각해서 개발해야 한다. 그래야 콤포넌트의 코드가 최적화되고 불필요한 코드가 들어가는 일을 최소화 할 수 있을 것이다.
부모 클래스인 TCustomLabel이 그리는 루틴은 필요가 없으므로 Inherited Paint 문장을 사용하지 않았다. 실제로 캡션과 외곽선을 그리는 프로시저인 DoDrawEdge, DoDrawCaption 프로시저는 protected 영역에 만들었다. 부모 클래스에서 적용되는 몇가지 프로퍼티 예를 들어 Alignment, Layout, Transparent, ShowAccelChar등이 필요 없는 프로퍼티가 되지 않도록 이들 프로퍼티의 값도 고려해서 그리는 Paint 루틴을 만든다.
캡션을 3차원으로 그리는 원리는 소스 코드를 살펴 보면 쉽게 알 수 있을 것이다. 글자를 출력하는 위치와 글자의 색깔을 적절한 순서대로 변경해가면서 출력해 주면 간단하게 3차원 효과를 구현할 수 있다. 글자를 출력할 때 Canvas의 TextOut이나 TextRect를 사용하지 않고 윈도 API인 DrawText를 사용한 이유는 TextOut이나 TextRect는 DrawText를 간단하게 사용할 수 있도록 해 놓은 메소드라서 DrawText만큼 플래그를 이용해서 다양하게 출력할 수 없기 때문이다.
외곽선도 마찬가지로 Canvas의 메소드에는 DrawEdge처럼 간단하게 3차원 사각형을 그리는 메소드가 없기 때문에 윈도 GDI API인 DrawEdge 함수를 이용했다.

2.4. 쉘 변화 감지 콤포넌트 개발

윈도 탐색기를 두 개 띄워 놓고 한쪽 탐색기에서 파일을 삭제하거나 새 파일을 만들면 다른 탐색기에도 그 내용이 똑 같이 반영되는 것을 볼 수 있다. 또한 상용 텍스트 편집기등을 보면 자기가 편집하고 있는 파일이 다른 프로그램에 의해 삭제되거나 내용이 변경되었다는 것을 알고 다시 읽어 들일지를 물어 보는 경우가 있다. 윈도 시스템 디렉토리에 있는 shell32.dll은 등록된 윈도에 대해 윈도 쉘에 변화가 생기면(이벤트) 등록한 메시지를 보내주는 메커니즘을 가지고 있다. 반대의 개념으로 우리가 어플리케이션에서 파일을 삭제하거나 생성했을 때 이를 윈도 시스템에 통보할 수 있는데 이때 사용하는 API인 SHChangeNotify는 WIN32 SDK에 자세하게 설명되어 있지만 윈도 쉘에 변화가 생길 때마다 내가 지정한 특정 윈도에 통보 메시지를 보내 주도록 하고 싶을 때 사용하는 API인 SHChangeNotifyRegister, SHChangeNotifyDeregister는 WIN32 SDK 도움말에 설명되어 있지 않다. 이 API들은 문서화 되지 않은 API이기 때문에 DLL이 업그레이드 되거나 삭제되면 이 API들을 사용할 수 없게 될 수도 있지만 현재 Windows 95, Windows 98, Windows NT 4.0에서는 모두 사용할 수 있으므로 이런 윈도 시스템의 이벤트 통지 기능을 콤포넌트로 구현해서 변화가 생길 때 마다 이벤트를 발생시키는 콤포넌트를 만들어 보자.
shell32.dll에서 두 번째로 정의되어 있는 ShChangeNotifyRegister 함수의 원형은 아래와 같다.

function SHChangeNotifyRegister(WindowHandle: HWND;
                                uFlags : UINT;
                                wEventId : LongInt;
                                uMsg : UINT;
                                cItems : DWORD;
                                Items : PPIDLStruct) : THandle; stdcall;

첫번째 인자인 WindowHandle은 통보 메시지를 받을 윈도에 대한 핸들을 가리킨다. uFlags는 이벤트를 필터링하는 데 사용하며 wEventId는 받을 이벤트에 대한 마스크를 넣어 준다. uMsg는 이벤트가 발생했을 때 받을 메시지를 입력하는데 보통 사용자 메시지를(WM_USER + n) 정의해서 사용한다. 그리고 Items 인자는 PIDLStruct형 배열에 대한 포인터이며 cItems는 Items 인자의 배열 개수를 나타낸다. WEventID에 지정할 수 있는 이벤트의 종류는 SHChangeNotify의 도움말을 보면 자세하게 나와 있다.
SHChangeNotifyRegister의 반환값은 핸들이며 이 값은 SHChangeNotifyDeregister를 이용해서 등록을 해제할 때 사용한다. shell32.dll에서 네 번째로 정의되어 있는 ShChangeNotifyDeregister 함수의 원형은 아래와 같으며 인자는 SHChangeNotifyRegister에서 반환한 핸들이다.

function SHChangeNotifyDeregister(hNotify : THandle) : BOOL; stdcall;

한가지 주의할 것은 SHChangeNotify의 도움말에 나타나 있는 모든 이벤트가 설명된 대로 동작하지 않는다는 것이다. 예를 들어 파일의 속성을 변경하면 SHCNE_ATTRIBUTES 이벤트가 발생한다고 되어 있지만 이 이벤트는 발생하지 않고 SHCNE_UPDATEITEM 이벤트만 발생한다. 개인적인 생각이지만 아마도 완벽하게 구현되지 않아서 SHChangeNotifyRegister와 SHChangeNotifyDeregister를 문서화하지 않은 듯 싶다.
이 콤포넌트의 이름은 TdpbShellNotify로 하고 시각적인 기능이 필요 없으므로 TComponent에서 상속 받자. 완성된 콤포넌트의 소스 코드와 예제 프로그램 동작 화면을 아래에 나타내었다.

그림 2-12 쉘 변화 감지 콤포넌트 예제 화면

리스트 2.5 dpbShellNotify.pas

unit dpbShellNotify;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  FileCtrl,
  ShellApi,
  ShlObj,
  ActiveX;

type
  TPIDLStruct = packed record
    pidlPath:      PItemIDList;
    bWatchSubtree: BOOL;
  end;
  PPIDLStruct = ^TPIDLStruct;

  TSHNotifyStruct = packed record
    PIDL1: PItemIDList;
    PIDL2: PItemIDList;
  end;
  PSHNotifyStruct = ^TSHNotifyStruct;

  TdpbNotifyDouble  = procedure(Sender: TObject;
                                OldPIDL: PItemIdList;
                                OldPath: TFileName;
                                NewPIDL: PItemIdList;
                                NewPath: TFileName) of object;

  TdpbNotifySingle  = procedure(Sender: TObject;
                                PIDL: PItemIdList;
                                Path: TFileName) of object;

  TdpbRootFolder =
  (
    drtCustomPath,
    drtDesktop,
    drtProgramFiles,
    drtControlPanel,
    drtPrinters,
    drtMyDocuments,
    drtFavorites,
    drtStartup,
    drtRecent,
    drtSendTo,
    drtRecycleBin,
    drtStartMenu,
    drtDesktopDirectory,
    drtDrives,
    drtNetwork,
    drtNethoodDirectory,
    drtFonts,
    drtTemplates,
    drtCommonStartMenu,
    drtCommonProgramFiles,
    drtCommonStartup,
    drtCommonDesktopDirectory,
    drtCommonAppData,
    drtCommonPrinters
  );

  TdpbShellNotify = class(TComponent)
  private
    { Private declarations }
    FActive : Boolean;
    FHandle : HWND;
    FSHNotifyHandle : THandle;
    FRootPIDL : PItemIDList;
    FRootFolder : TdpbRootFolder;

    FOnRename : TdpbNotifyDouble;
    FOnCreate : TdpbNotifySingle;
    FOnDelete : TdpbNotifySingle;
    FOnUpdate : TdpbNotifySingle;
    FOnAttributesChanged : TdpbNotifySingle;
    FOnMakeDir : TdpbNotifySingle;
    FOnRemoveDir : TdpbNotifySingle;
    FOnUpdateDir : TdpbNotifySingle;
    FOnRenameDir : TdpbNotifyDouble;
    FOnDriveRemoved : TdpbNotifySingle;
    FOnDriveAdded : TdpbNotifySingle;
    FCustomPath: string;

    procedure ProcessNotifyMessage(wEventID: Integer; SHNS: PSHNotifyStruct);
    procedure SetActive(const Value: Boolean);
    procedure SetRootFolder(const Value: TdpbRootFolder);
    procedure SetCustomPath(const Value: string);
  protected
    { Protected declarations }
    procedure WndProc(var Message : TMessage);
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure Register;
    procedure Deregister;
  published
    { Published declarations }
    property Active : Boolean
             read FActive
             write SetActive
             default False;

    property RootFolder : TdpbRootFolder
             read FRootFolder
             write SetRootFolder
             default drtDeskTop;

    property CustomPath : string
             read FCustomPath
             write SetCustomPath;

    property OnCreate : TdpbNotifySingle
             read FOnCreate
             write FOnCreate;

    property OnRename : TdpbNotifyDouble
             read FOnRename
             write FOnRename;

    property OnDelete : TdpbNotifySingle
             read FOnDelete
             write FOnDelete;

    property OnUpdate : TdpbNotifySingle
             read FOnUpdate
             write FOnUpdate;

    property OnAttributesChanged : TdpbNotifySingle
             read FOnAttributesChanged
             write FOnAttributesChanged;

    property OnMakeDir : TdpbNotifySingle
             read FOnMakeDir
             write FOnMakeDir;

    property OnRemoveDir : TdpbNotifySingle
             read FOnRemoveDir
             write FOnRemoveDir;

    property OnUpdateDir : TdpbNotifySingle
             read FOnUpdateDir
             write FOnUpdateDir;

    property OnRenameDir : TdpbNotifyDouble
             read FOnRenameDir
             write FOnRenameDir;

    property OnDriveRemoved : TdpbNotifySingle
             read FOnDriveRemoved
             write FOnDriveRemoved;

    property OnDriveAdded : TdpbNotifySingle
             read FOnDriveAdded
             write FOnDriveAdded;
  end;


const
  WM_SHELLNOTIFY = WM_USER + 1;

function SHChangeNotifyRegister(WindowHandle: HWND;
                                uFlags : UINT;
                                wEventId : LongInt;
                                uMsg : UINT;
                                cItems : DWORD;
                                Items : PPIDLStruct) : THandle; stdcall;

function SHChangeNotifyDeregister(hNotify : THandle) : BOOL; stdcall;
function ILCreateFromPath(Path: Pointer): PItemIDList; stdcall;
function GetPathFromPIDL(PIDL: PItemIDList): string; stdcall;
function GetPIDLFromPath(Path: string): PItemIDList; stdcall;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('DPB', [TdpbShellNotify]);
end;

const
  SHELL_DLL = 'Shell32.dll';

  { SHChangeNotifyRegister의 uFlags }
  SHCNF_ACCEPT_INTERRUPTS=0001;
  SHCNF_ACCEPT_NON_INTERRUPTS=0002;
  SHCNF_NO_PROXY=8000;


function SHChangeNotifyRegister;   external SHELL_DLL  Index 2;
function SHChangeNotifyDeregister; external SHELL_DLL  Index 4;
function ILCreateFromPath;         external SHELL_DLL  Index 157;

function  GetPathFromPIDL(PIDL: PItemIDList): string; stdcall;
var
  PathBuffer: Array[0..MAX_PATH] of Char;
begin
  Result := EmptyStr;
  if (PIDL = nil) then
    Exit;
  { PIDL에서 경로를 구한다. }
  SHGetPathFromIDList(PIDL, PathBuffer);
  Result := StrPas(PathBuffer);
end;

function GetPIDLFromPath(Path: string): PItemIDList; stdcall;
var
  Buffer: Array[0..MAX_PATH] of WideChar;
begin
  if (SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT) then
  begin
    StringToWideChar(Path, Buffer, (High(Buffer) - Low(Buffer) + 1));
  end
  else begin
    StrPLCopy(PChar(@Buffer), Path, SizeOf(Buffer));
  end;
  Result := ILCreateFromPath(@Buffer);
end;

function RootFolderToSpecialFolder(Value : TdpbRootFolder) : Integer;
begin
  case Value of
    drtDesktop:                Result := CSIDL_DESKTOP;
    drtProgramFiles:           Result := CSIDL_PROGRAMS;
    drtControlPanel:           Result := CSIDL_CONTROLS;
    drtPrinters:               Result := CSIDL_PRINTERS;
    drtMyDocuments:            Result := CSIDL_PERSONAL;
    drtFavorites:              Result := CSIDL_FAVORITES;
    drtStartup:                Result := CSIDL_STARTUP;
    drtRecent:                 Result := CSIDL_RECENT;
    drtSendTo:                 Result := CSIDL_SENDTO;
    drtRecycleBin:             Result := CSIDL_BITBUCKET;
    drtStartMenu:              Result := CSIDL_STARTMENU;
    drtDesktopDirectory:       Result := CSIDL_DESKTOPDIRECTORY;
    drtDrives:                 Result := CSIDL_DRIVES;
    drtNetwork:                Result := CSIDL_NETWORK;
    drtNethoodDirectory:       Result := CSIDL_NETHOOD;
    drtFonts:                  Result := CSIDL_FONTS;
    drtTemplates:              Result := CSIDL_TEMPLATES;
    drtCommonStartMenu:        Result := CSIDL_COMMON_STARTMENU;
    drtCommonProgramFiles:     Result := CSIDL_COMMON_PROGRAMS;
    drtCommonStartup:          Result := CSIDL_COMMON_STARTUP;
    drtCommonDesktopDirectory: Result := CSIDL_COMMON_DESKTOPDIRECTORY;
    drtCommonAppData:          Result := CSIDL_APPDATA;
    drtCommonPrinters:         Result := CSIDL_PRINTHOOD;
    else                       Result := CSIDL_DESKTOP;
  end;
end;

{ TdpbShellNotify }

constructor TdpbShellNotify.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSHNotifyHandle := INVALID_HANDLE_VALUE;
  FRootPIDL := nil;
  { 윈도 핸들을 강제로 할당한다. }
  FHandle := AllocateHWND(WndProc);
  FActive := False;
  FRootFolder := drtDeskTop;
end;

destructor TdpbShellNotify.Destroy;
begin
  { 등록을 해제 한다. }
  if FSHNotifyHandle <> INVALID_HANDLE_VALUE then
    Deregister;

  { 윈도 핸들 해제 }
  DeallocateHWnd(FHandle);
  inherited Destroy;
end;

{ 쉘 통지 메시지 등록 }
procedure TdpbShellNotify.Register;
var
  PS : TPIDLStruct;
begin
  if FSHNotifyHandle = INVALID_HANDLE_VALUE then
  begin
    if FRootFolder = artCustomPath then
    begin
      if (Length(FCustomPath) > 0) and DirectoryExists(FCustomPath) then
      begin
        FRootPIDL := GetPIDLFromPath(FCustomPath);
      end
      else
        SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, FRootPIDL);
    end
    else
    begin
      SHGetSpecialFolderLocation(0, RootFolderToSpecialFolder(FRootFolder), FRootPIDL);
    end;
    PS.pidlPath := FRootPIDL;
    PS.bWatchSubtree := True;

    FSHNotifyHandle := SHChangeNotifyRegister(FHandle,
                                  SHCNF_ACCEPT_INTERRUPTS or SHCNF_ACCEPT_NON_INTERRUPTS,
                                  SHCNE_ALLEVENTS,
                                  WM_SHELLNOTIFY,
                                  1, @PS);
  end;
end;

procedure TdpbShellNotify.Deregister;
begin
  if FSHNotifyHandle <> INVALID_HANDLE_VALUE then
  begin
    if SHChangeNotifyDeregister(FSHNotifyHandle) then
    begin
      FSHNotifyHandle := INVALID_HANDLE_VALUE;
      CoTaskMemFree(FRootPIDL);
      FRootPIDL := nil;
    end;
  end;
end;

procedure TdpbShellNotify.WndProc(var Message: TMessage);
begin
  with Message do
  begin
    if Msg = WM_SHELLNOTIFY then
    begin
      ProcessNotifyMessage(lParam, PSHNotifyStruct(wParam));
      Result := 1;
    end
    else
      Result := DefWindowProc(FHandle, Msg, wParam, lParam);
  end;
end;

procedure TdpbShellNOtify.ProcessNotifyMessage(wEventID : Longint;
   SHNS : PSHNotifyStruct);
var
  Path1 : TFileName;
  Path2 : TFileName;
begin
  Path1 := GetPathFromPIDL(SHNS.PIDL1);
  Path2 := GetPathFromPIDL(SHNS.PIDL2);
  case wEventID of
    SHCNE_RENAMEITEM   :
      if Assigned(FOnRename) then
        FOnRename(Self, SHNS.PIDL1, Path1, SHNS.PIDL2, Path2);
    SHCNE_CREATE       :
      if Assigned(FOnCreate) then
        FOnCreate(Self, SHNS.PIDL1, Path1);
    SHCNE_DELETE       :
      if Assigned(FOnDelete) then
        FOnDelete(Self, SHNS.PIDL1, Path1);
    SHCNE_UPDATEITEM   :
      if Assigned(FOnUpdate) then
        FOnUpdate(Self, SHNS.PIDL1, Path1);
    SHCNE_ATTRIBUTES   :
      if Assigned(FOnAttributesChanged) then
        FOnAttributesChanged(Self, SHNS.PIDL1, Path1);
    SHCNE_MKDIR        :
      if Assigned(FOnMakeDir) then
        FOnMakeDir(Self, SHNS.PIDL1, Path1);
    SHCNE_RMDIR        :
      if Assigned(FOnRemoveDir) then
        FOnRemoveDir(Self, SHNS.PIDL1, Path1);
    SHCNE_UPDATEDIR    :
      if Assigned(FOnUpdateDir) then
        FOnUpdateDir(Self, SHNS.PIDL1, Path1);
    SHCNE_RENAMEFOLDER :
      if Assigned(FOnRenameDir) then
        FOnRenameDir(Self, SHNS.PIDL1, Path1, SHNS.PIDL2, Path2);
    SHCNE_DRIVEREMOVED :
      if Assigned(FOnDriveRemoved) then
        FOnDriveRemoved(Self, SHNS.PIDL1, Path1);
    SHCNE_DRIVEADD     :
      if Assigned(FOnDriveAdded) then
        FOnDriveAdded(Self, SHNS.PIDL1, Path1);
  end;
end;

procedure TdpbShellNotify.Loaded;
begin
  inherited Loaded;
  { 자동 등록 }
  if not (csDesigning in ComponentState) and FActive then
  begin
    Register;
  end;
end;

procedure TdpbShellNotify.SetActive(const Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    if not (csDesigning in ComponentState) then
    begin
      if FActive then Register
      else  Deregister;
    end;
  end;
end;

procedure TdpbShellNotify.SetRootFolder(const Value: TdpbRootFolder);
begin
  if FRootFolder <> Value then
  begin
    FRootFolder := Value;
    if not (csDesigning in ComponentState) and FActive then
    begin
      Deregister;
      Register;
    end;
  end;
end;

procedure TdpbShellNotify.SetCustomPath(const Value: string);
begin
  if FCustomPath <> Value then
  begin
    FCustomPath := Value;
    if FRootFolder = drtCustomPath then
    begin
      if not (csDesigning in ComponentState) and FActive then
      begin
        Deregister;
        Register;
      end;
    end;
  end;
end;

end.

TdpbShellNotify는 자신이 등록한 윈도 메시지를 받아야 한다. 그런데 이전 장에서도 얘기했지만 TComponent는 윈도 핸들을 가지고 있지 않기 때문에 윈도 메시지를 받을 수 없다. 그래서 강제로 윈도 핸들을 만들어 주어야 하는데 이 때 사용하는 함수가 Forms.pas에 정의된 AllocateHWnd 이다. AllocateHWnd 함수는 메시지를 받아서 처리할 윈도 프로시저를 인자로 받는다. 따라서 TWndMethod 형의 윈도 프로시저 WndProc을 만들고 이를 AllocateHWnd 함수를 호출할 때 인자로 넣어 주면 이 프로시저에서 메시지를 처리할 수 있다. 윈도 핸들을 모두 사용했으면 반드시DeallocateHWnd 프로시저를 이용해서 핸들을 해제해 주어야 한다. TdpbShellNotify는 콤포넌트의 생성자에서 AllocateHWnd를 호출해서 윈도 핸들을 생성하고 소멸자에서 DeallocateHWnd를 호출하도록 했다.
설계 시에 Active 프로퍼티를 True로 해 놓으면 어플리케이션이 실행될 때 자동으로 쉘에서 발생한 변화를 감지할 수 있도록 했는데 이를 구현하기 위해서 모든 프로퍼티가 폼 파일에서 읽혀 진 후에 호출되는 Loaded 가상 메소드를 오버라이드 해서 Active 프로퍼티가 True이고 ComponentState 프로퍼티를 조사해서 폼을 설계 중이 아닌 경우에 Register 프로시저를 호출하도록 했다.
이밖에 RootFolder 프로퍼티와 CustomPath 프로퍼티를 만들었는데 RootFolder 프로퍼티는 TdpbShellNotify 콤포넌트가 감시할 폴더의 위치를 지정한다. RootFolder 프로퍼티의 값이 drtCustomPath이면 CustomPath 프로퍼티에 지정된 디렉토리를 감시하도록 했다.

저작권에 대한 공지