unit CmCtrl;

interface

uses
  Windows,
  Messages,
  CommCtrl,
  UtilFunc,
  UTilClass;


type

TNotifyNotify = procedure (var Msg:TMessage;NMHdr:TNMHdr);

PNMMouse = ^TNMMouse;
TNMMouse = packed record
  hdr: TNMHdr;
  ItemSpec:DWORD;
  ItemData:DWORD;
  pt:TPoint;
  HtInfo:LPARAM;
end;

TEffRect = record
  Mark:integer;
  ID: integer;
end;

const
  SBN_SIMPLEMODECHANGE = -880;

type
//------------------ TCmCtrl --------------------------------------
TCmCtrl = class(TSubClass)
private
  FHandle: HWND;
  FID: HMenu;
  FOnClick:TNotifyNotify;
  FOnDblClick:TNotifyNotify;
  FOnRClick:TNotifyNotify;
  FOnRDblClick:TNotifyNotify;
  function GetEnable: Boolean;
  procedure SetEnable(value:Boolean);
  function GetVisible: Boolean;
  procedure SetVisible(value: Boolean);
protected
  procedure CreateControl; virtual; abstract;
public
  constructor Create(hParent: HWND); override;
  destructor Destroy; override;
  property Handle: HWND read FHandle;
  property ID: HMenu read FID;
  property Enable: Boolean read GetEnable write SetEnable;
  property Visible: Boolean read GetVisible write SetVisible;
  property OnClick:TNotifyNotify read FOnClick write FOnClick;
  property OnDblClick:TNotifyNotify read FOnDblClick write FOnDblClick;
  property OnRClick:TNotifyNotify read FOnRClick write FOnRClick;
  property OnRDblClick:TNotifyNotify read FOnRDblClick write FOnRDblClick;
end;

//----------------- TAPIStatusBar -----------------------------------
TSBTextStyle = (SUNKEN, NOBORDER, RAISED);

TAPIStatusBar = class(TCmCtrl)
private
  FPartsWidth: array [0..9] of integer;
  FTextStyle: array [0..9] of TSBTextStyle;
  FTOP:Boolean;
  FSimple:Boolean;
  FMinHeight:integer;
  FOnSize: TNotifyMessage;
  FOnSimpleChange:TNotifyNotify;
  procedure SetTOP(value:Boolean);
  function GetNumParts:integer;
  procedure SetNumParts(val:integer);
  function GetPartsWidth(i:integer):integer;
  procedure SetPartsWidth(i,val:integer);
  function GetText(i:integer):string;
  procedure SetText(i:integer;s:string);
  function GetTextStyle(i:integer):TSBTextStyle;
  procedure SetTextStyle(i:integer;style:TSBTextStyle);
  procedure SetSimple(val:Boolean);
  function GetSimpleText:string;
  procedure SetSimpleText(value:string);
  function GetRect(value:integer):TRect;
  procedure SetMinHeight(value:integer);
protected
  procedure CreateControl;override;
public
  constructor Create(hParent:HWND); override;
  procedure DefaultHandler(var Message);override;
  procedure Invalidate;
  property TOP:Boolean read FTOP write SetTOP;
  property NumParts:integer read GetNumParts write SetNumParts;
  property PartsWidth[i:integer]:integer read GetPartsWidth
                                           write SetPartsWidth;
  property Text[i:integer]:string read GetText write SetText;
  property TextStyle[i:integer]:TSBTextStyle read GetTextStyle
                                               write SetTextStyle;
  property Simple:Boolean read FSimple write SetSimple;
  property SimpleText:string read GetSimpleText write SetSimpleText;
  property Rect[i:integer]: TRect read GetRect;
  property MinHeight:integer read FMinHeight write SetMinHeight;
  property OnSize:TNotifyMessage read FOnSize write FOnSize;
  property OnSimpleChange:TNotifyNotify read FOnSimpleChange
                                         write FOnSimpleChange;
end;

//----------------- TEffecRect -------------------------------------
type
TEffecRect = class(TSubClass)
private
  FOnSize: TNotifyMessage;
  FIDArray: array[0..5] of TEffRect;
  FEffectiveRect:TRect;
  function GetItemID(i:integer):integer;
  procedure SetItemID(i,value:integer);
  function GetEffectiveDim:TRect;
protected
public
  constructor Create(hParent:HWND); override;
  procedure DefaultHandler(var Message);override;
  procedure ReCalc;
  property OnSize:TNotifyMessage read FOnSize write FOnSize;
  property ItemID[i:integer]:integer read GetItemID write SetItemID;
  property EffectiveDim:TRect read GetEffectiveDim;
end;

//------------------ TMenuHelp -----------------------------------
TMenuHelp = class(TSubClass)
private
  FhStatusBar: HWND;
  FID: TIntegerList;
  FSA: TStringArray;
  function GetNumList:integer;
protected
  procedure InitArray;
public
  constructor Create(hParent: HWND); override;
  destructor Destroy; override;
  procedure DefaultHandler(var Message);override;
  procedure AddList(mID:integer;sStr:string);
  property hStatusBar:HWND read FhStatusBar write FhStatusBar;
  property NumList:integer read GetNumList;
end;


function CreateStatusBar(hParent:HWND;Top:Boolean):TAPIStatusbar;



implementation

var
  ID_CmCtrl:integer = 1000;

//------------------ TCmCtrl --------------------------------------
constructor TCmCtrl.Create(hParent: HWND);
begin
  inherited Create(hParent);
  Dispatcher.TrapMessage(WM_NOTIFY,self);
  InitCommonControls;
end;

destructor TCmCtrl.Destroy;
begin
  DestroyWindow(FHandle);
  inherited Destroy;
end;

function TCmCtrl.GetEnable: Boolean;
begin
  result := Boolean(IsWindowEnabled(FHandle));
end;

procedure TCmCtrl.SetEnable(value: Boolean);
begin
  EnableWindow(FHandle,value);
end;

function TCmCtrl.GetVisible: Boolean;
begin
  result := Boolean(IsWindowVisible(FHandle));
end;

procedure TCmCtrl.SetVisible(value:Boolean);
begin
  if value then
    ShowWindow(FHandle,SW_SHOWNORMAL)
  else
    ShowWindow(FHandle,SW_HIDE);
end;

//------------ TAPIStatusBar   ------------------------------------------------
constructor TAPIStatusBar.Create(hParent:HWND);
var
  i: integer;
begin
  inherited Create(hParent);

  CreateControl;
  Dispatcher.TrapMessage(WM_SIZE,self);

  for i := 0 to 9 do FPartsWidth[i] := 80;
end;

procedure TAPIStatusBar.CreateControl;
begin
  FHandle := CreateStatusWindow(WS_CHILD or WS_VISIBLE or WS_CLIPCHILDREN or
                 WS_CLIPSIBLINGS or CCS_TOP,'APIStatusBar',Parent,ID_CmCtrl);
  FID := ID_CmCtrl;
  inc(ID_CmCtrl);
end;

procedure TAPIStatusBar.DefaultHandler(var Message);
var
  AMsg:TMessage;
  phdr: PNMHdr;
begin
  AMsg := TMessage(Message);

  case AMsg.Msg of

    WM_SIZE: begin
      SendMessage(FHandle,AMsg.Msg,AMsg.WParam,AMsg.LParam);
      if (AMsg.WParam+AMsg.LParam) = 0 then exit;
      AMsg.Msg := UINT(self);
      if Assigned(FOnSize) then OnSize(AMsg);
    end;

    WM_NOTIFY:begin
      phdr := Pointer(AMsg.LParam);
      if FHandle <> phdr^.hwndFrom then exit;
      AMsg.Msg := UINT(self); // Sender
      case phdr^.code of
        NM_CLICK:if Assigned(FOnClick) then FOnClick(AMsg,phdr^);
        NM_DBLCLK:if Assigned(FOnDblClick) then FOnDblClick(AMsg,phdr^);
        NM_RCLICK:if Assigned(FOnRClick) then FOnRClick(AMsg,phdr^);
        NM_RDBLCLK:if Assigned(FOnRDblClick) then FOnRDBlClick(AMsg,phdr^);
        SBN_SIMPLEMODECHANGE:if Assigned(FOnSimpleChange) then
                                FOnSimpleChange(AMsg,phdr^);
      end;
    end;

  end;
end;

procedure TAPIStatusBar.Invalidate;
begin
  SendMessage(FHandle,WM_SIZE,0,0);
end;

procedure TAPIStatusBar.SetTOP(value:Boolean);
var
  st: integer;
begin
  FTOP := value;
  st := GetWindowLong(FHandle,GWL_STYLE);
  if value then
    st := st or CCS_TOP
  else
    st := st and (not CCS_TOP);
  SetWindowLong(FHandle,GWL_STYLE,st);
  Invalidate;
end;

function TAPIStatusBar.GetNumParts: integer;
begin
  result := SendMessage(FHandle,SB_GETPARTS,0,0);
end;

procedure TAPIStatusBar.SetNumParts(val: integer);
var
  PartsX: array [0..9] of integer;
  i: integer;
begin
  if val > 9 then exit;
  if val = 1 then begin
    PartsX[0] := -1;
    SendMessage(FHandle,SB_SETPARTS,1,integer(@PartsX[0]));
  end else begin
    PartsX[0] := FPartsWidth[0];
    for i := 1 to val-1 do PartsX[i] := PartsX[i-1]+FPartsWidth[i];
    PartsX[val-1] := -1;
    SendMessage(FHandle,SB_SETPARTS,val,integer(@PartsX[0]));
  end;
end;

function TAPIStatusBar.GetPartsWidth(i: integer): integer;
begin
  if i > 9 then begin
    result := 0;
    exit;
  end;
  result := FPartsWidth[i];
end;

procedure TAPIStatusBar.SetPartsWidth(i,val: integer);
begin
  if i > 9 then exit;
  FPartsWidth[i] := val;
  SetNumParts(NumParts);
end;

function TAPIStatusBar.GetText(i: integer): string;
var
  Len: integer;
begin
  if (i > 9) and not (i = 255) then exit;
  SetLength(result,200);
  Len := LOWORD(SendMessage(FHandle,SB_GETTEXT,i,integer(PChar(result))));
  SetLength(result,Len);
end;

procedure TAPIStatusBar.SetText(i: integer; s: string);
var
  ts: integer;
begin
  if i > 9 then
    if i = 255 then begin
      SendMessage(FHandle,SB_SETTEXT,i,integer(PChar(s)));
      exit;
    end
  else
    exit;
  case FTextStyle[i] of
    NOBORDER: ts := SBT_NOBORDERS;
    RAISED: ts := SBT_POPOUT;
  else
    ts := 0;
  end;
  SendMessage(FHandle,SB_SETTEXT,i or ts,integer(PChar(s)));
end;

function TAPIStatusBar.GetTextStyle(i: integer): TSBTextStyle;
begin
  result := FTextStyle[i];
end;

procedure TAPIStatusBar.SetTextStyle(i: integer; style: TSBTextStyle);
var
  s: string;
begin
  FTextStyle[i] := style;
  s := GetText(i);
  SetText(i,s);
  InvalidateRect(FHandle,nil,true);
end;

procedure TAPIStatusBar.SetSimple(val: Boolean);
begin
  if FSimple = val then exit;
  FSimple := val;
  SendMessage(FHandle,SB_SIMPLE,integer(val),0);
end;

function TAPIStatusBar.GetSimpleText:string;
begin
  result := GetText(255);
end;

procedure TAPIStatusBar.SetSimpleText(value:string);
begin
  SetText(255,value);
end;

function TAPIStatusBar.GetRect(value:integer):TRect;
begin
  if value = -2 then
    GetClientrect(FHandle,result)
  else
    SendMessage(FHandle,SB_GETRECT,value,integer(@result));
end;

procedure TAPIStatusBar.SetMinHeight(value:integer);
begin
  FMinHeight := value;
  SendMessage(FHandle,SB_SETMINHEIGHT,value,0);
  Invalidate;
end;

function CreateStatusBar(hParent:HWND;Top:Boolean):TAPIStatusbar;
begin
  result := TAPIStatusbar.Create(hParent);
  result.TOP := Top;
end;

//----------------- TEffecRect -------------------------------------
constructor TEffecRect.Create(hParent:HWND);
begin
  inherited Create(hParent);
  Dispatcher.TrapMessage(WM_SIZE,self);
  FIDArray[0].Mark := 1; FIDArray[0].ID := 1;
end;

procedure TEffecRect.DefaultHandler(var Message);
var
  AMsg:TMessage;
begin
  AMsg := TMessage(Message);
  case AMsg.Msg of
    WM_SIZE: begin
      GetEffectiveClientRect(Parent,@FEffectiveRect,@FIDArray[0]);
      AMsg.Msg := UINT(self);
      if Assigned(FOnSize) then FOnSize(AMsg);
    end;
  end;
end;

procedure TEffecRect.ReCalc;
var
  Msg:TMessage;
begin
  Msg.Msg := WM_SIZE; 
  Dispatch(Msg);
end;

function TEffecRect.GetItemID(i:integer):integer;
begin
  result := 0;
  if (i<1) or (i>4) then exit;
  result := FIDArray[i].ID;
end;

procedure TEffecRect.SetItemID(i,value:integer);
begin
  if (i<1) or (i>4) then exit;
  FIDArray[i].Mark := 1; FIDArray[i].ID := value;
end;

function TEffecRect.GetEffectiveDim:TRect;
var
  r:TRect;
begin
  r := FEffectiveRect;
  result := SetDim(r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top);
end;

//------------------ TMenuHelp -----------------------------------
constructor TMenuHelp.Create(hParent: HWND);
begin
  inherited Create(hParent);
  FID := TIntegerList.Create(0,0);
  FSA := TStringArray.Create;
  InitArray;
  Dispatcher.TrapMessage(WM_ENTERMENULOOP,self);
  Dispatcher.TrapMessage(WM_MENUSELECT,self);
  Dispatcher.TrapMessage(WM_EXITMENULOOP,self);
end;

destructor TMenuHelp.Destroy;
begin
  FID.Free;
  FSA.Free;
  inherited Destroy;
end;

procedure TMenuHelp.DefaultHandler(var Message);
var
  AMsg:TMessage;
  i,ID:integer;
begin
  AMsg := TMessage(Message);
  case AMsg.Msg of
    WM_ENTERMENULOOP:SendMessage(FhStatusBar,SB_SIMPLE,1,0);
    WM_EXITMENULOOP:SendMessage(FhStatusBar,SB_SIMPLE,0,0);
    WM_MENUSELECT:begin
      if (AMsg.WParamHi and MF_POPUP) <> 0 then
        ID := MenuItemID(AMsg.LParam,AMsg.WParamLo)
      else
        ID := AMsg.WParamLo;

      if ID = 0 then exit;

      i := FID.Search(ID);
      if i <> -1 then
        SendMessage(FhStatusBar,SB_SETTEXT,255,integer(PChar(FSA[i])));
    end;
  end;
end;

procedure TMenuHelp.InitArray;
begin
  FID.Add(SC_RESTORE); FSA.Add('ウィンドウのサイズを元に戻します');
  FID.Add(SC_MOVE); FSA.Add('ウィンドウを移動します');
  FID.Add(SC_SIZE); FSA.Add('ウィンドウのサイズを変更します');
  FID.Add(SC_MINIMIZE); FSA.Add('ウィンドウを最小化します');
  FID.Add(SC_MAXIMIZE); FSA.Add('ウィンドウを最大化します');
  FID.Add(SC_CLOSE); FSA.Add('このウィンドウが閉じます');
end;

procedure TMenuHelp.AddList(mID:integer;sStr:string);
begin
  FID.Add(mID); FSA.Add(sStr);
end;

function TMenuHelp.GetNumList:integer;
begin
  result := FID.Count;
end;

end.