diff options
Diffstat (limited to 'delphi/Awkward/utils/wrapper.pas')
| -rw-r--r-- | delphi/Awkward/utils/wrapper.pas | 450 |
1 files changed, 0 insertions, 450 deletions
diff --git a/delphi/Awkward/utils/wrapper.pas b/delphi/Awkward/utils/wrapper.pas deleted file mode 100644 index c7b4d05..0000000 --- a/delphi/Awkward/utils/wrapper.pas +++ /dev/null @@ -1,450 +0,0 @@ -{$include compilers.inc}
-unit wrapper;
-
-interface
-uses windows;
-
-function GetScreenRect():TRect;
-procedure SnapToScreen(var rc:TRect;dx:integer=0;dy:integer=0{;
- minw:integer=240;minh:integer=100});
-
-function LV_GetLParam (list:HWND;item:integer=-1):integer;
-function LV_SetLParam (list:HWND;lParam:dword;item:integer=-1):integer;
-function LV_ItemAtPos(wnd:HWND;Pt:TPOINT;var SubItem:dword):Integer; overload;
-function LV_ItemAtPos(wnd:HWND;x,y:integer;var SubItem:dword):Integer; overload;
-procedure LV_SetItem (handle:hwnd;str:PAnsiChar;item:integer;subitem:integer=0);
-procedure LV_SetItemW(handle:hwnd;str:PWideChar;item:integer;subitem:integer=0);
-function LV_MoveItem(list:hwnd;direction:integer;item:integer=-1):integer;
-function LV_GetColumnCount(list:HWND):integer;
-function LV_CheckDirection(list:HWND):integer; // bit 0 - can move up, bit 1 - down
-
-function GetDlgText(Dialog:HWND;idc:integer;getAnsi:boolean=false):pointer; overload;
-function GetDlgText(wnd:HWND;getAnsi:boolean=false):pointer; overload;
-function ShowDlg (dst:PAnsiChar;fname:PAnsiChar=nil;Filter:PAnsiChar=nil;open:boolean=true):boolean;
-function ShowDlgW(dst:PWideChar;fname:PWideChar=nil;Filter:PWideChar=nil;open:boolean=true):boolean;
-
-function SelectDirectory(Caption:PAnsiChar;var Directory:PAnsiChar;
- Parent:HWND=0;newstyle:bool=false):Boolean; overload;
-function SelectDirectory(Caption:PWideChar;var Directory:PWideChar;
- Parent:HWND=0;newstyle:bool=false):Boolean; overload;
-
-function CB_SelectData(cb:HWND;data:dword):integer; overload;
-function CB_SelectData(Dialog:HWND;id:cardinal;data:dword):integer; overload;
-function CB_GetData (cb:HWND;idx:integer=-1):dword;
-function CB_AddStrData (cb:HWND;astr:pAnsiChar;data:integer=0;idx:integer=-1):HWND;
-function CB_AddStrDataW(cb:HWND;astr:pWideChar;data:integer=0;idx:integer=-1):HWND;
-
-implementation
-uses messages,common,shlobj,activex,commctrl,commdlg;
-
-{.$IFNDEF DELPHI10_UP}
-const
- LVM_SORTITEMSEX = LVM_FIRST + 81;
-{.$ENDIF}
-{$IFNDEF DELPHI7_UP}
-const
- BIF_NEWDIALOGSTYLE = $0040;
-const
- SM_XVIRTUALSCREEN = 76;
- SM_YVIRTUALSCREEN = 77;
- SM_CXVIRTUALSCREEN = 78;
- SM_CYVIRTUALSCREEN = 79;
-{$ENDIF}
-
-function GetScreenRect():TRect;
-begin
- result.left := GetSystemMetrics( SM_XVIRTUALSCREEN );
- result.top := GetSystemMetrics( SM_YVIRTUALSCREEN );
- result.right := GetSystemMetrics( SM_CXVIRTUALSCREEN ) + result.left;
- result.bottom:= GetSystemMetrics( SM_CYVIRTUALSCREEN ) + result.top;
-end;
-
-procedure SnapToScreen(var rc:TRect;dx:integer=0;dy:integer=0{;
- minw:integer=240;minh:integer=100});
-var
- rect:TRect;
-begin
- rect:=GetScreenRect;
- if rc.right >rect.right then rc.right :=rect.right -dx;
- if rc.bottom>rect.bottom then rc.bottom:=rect.bottom-dy;
- if rc.left <rect.left then rc.left :=rect.left;
- if rc.top <rect.top then rc.top :=rect.top;
-end;
-
-function GetDlgText(wnd:HWND;getAnsi:boolean=false):pointer;
-var
- a:cardinal;
-begin
- result:=nil;
- if getAnsi then
- begin
- a:=SendMessageA(wnd,WM_GETTEXTLENGTH,0,0)+1;
- if a>1 then
- begin
- mGetMem(PAnsiChar(result),a);
- SendMessageA(wnd,WM_GETTEXT,a,longint(result));
- end;
- end
- else
- begin
- a:=SendMessageW(wnd,WM_GETTEXTLENGTH,0,0)+1;
- if a>1 then
- begin
- mGetMem(pWideChar(result),a*SizeOf(WideChar));
- SendMessageW(wnd,WM_GETTEXT,a,longint(result));
- end;
- end;
-end;
-
-function GetDlgText(Dialog:HWND;idc:integer;getAnsi:boolean=false):pointer;
-begin
- result:=GetDlgText(GetDlgItem(Dialog,idc),getAnsi);
-end;
-
-function ShowDlg(dst:PAnsiChar;fname:PAnsiChar=nil;Filter:PAnsiChar=nil;open:boolean=true):boolean;
-var
- NameRec:OpenFileNameA;
-begin
- FillChar(NameRec,SizeOf(NameRec),0);
- with NameRec do
- begin
- LStructSize:=SizeOf(NameRec);
- if fname=nil then
- dst[0]:=#0
- else if fname<>dst then
- StrCopy(dst,fname);
-// lpstrInitialDir:=dst;
- lpStrFile :=dst;
- lpStrFilter:=Filter;
- if Filter<>nil then
- begin
- lpstrDefExt:=StrEnd(Filter)+1;
- inc(lpstrDefExt,2); // skip "*."
- end;
- NMaxFile :=511;
- Flags :=OFN_EXPLORER or OFN_OVERWRITEPROMPT;// or OFN_HIDEREADONLY;
- end;
- if open then
- result:=GetOpenFileNameA(NameRec)
- else
- result:=GetSaveFileNameA(NameRec);
-end;
-
-function ShowDlgW(dst:PWideChar;fname:PWideChar=nil;Filter:PWideChar=nil;open:boolean=true):boolean;
-var
- NameRec:OpenFileNameW;
-begin
- FillChar(NameRec,SizeOf(NameRec),0);
- with NameRec do
- begin
- LStructSize:=SizeOf(NameRec);
- if fname=nil then
- dst[0]:=#0
- else if fname<>dst then
- StrCopyW(dst,fname);
-// lpstrInitialDir:=dst;
- lpStrFile :=dst;
- lpStrFilter:=Filter;
- if Filter<>nil then
- begin
- lpstrDefExt:=StrEndW(Filter)+1;
- inc(lpstrDefExt,2); // skip "*."
- end;
- NMaxFile :=511;
- Flags :=OFN_EXPLORER or OFN_OVERWRITEPROMPT;// or OFN_HIDEREADONLY;
- end;
- if open then
- result:=GetOpenFileNameW(NameRec)
- else
- result:=GetSaveFileNameW(NameRec)
-end;
-
-procedure LV_SetItem(handle:hwnd;str:PAnsiChar;item:integer;subitem:integer=0);
-var
- li:LV_ITEMA;
-begin
-// zeromemory(@li,sizeof(li));
- li.mask :=LVIF_TEXT;
- li.pszText :=str;
- li.iItem :=item;
- li.iSubItem:=subitem;
- SendMessageA(handle,LVM_SETITEMA,0,integer(@li));
-end;
-
-procedure LV_SetItemW(handle:hwnd;str:PWideChar;item:integer;subitem:integer=0);
-var
- li:LV_ITEMW;
-begin
-// zeromemory(@li,sizeof(li));
- li.mask :=LVIF_TEXT;
- li.pszText :=str;
- li.iItem :=item;
- li.iSubItem:=subitem;
- SendMessageW(handle,LVM_SETITEMW,0,integer(@li));
-end;
-
-function SelectDirectory(Caption:PAnsiChar;var Directory:PAnsiChar;
- Parent:HWND=0;newstyle:bool=false):Boolean;
-var
- BrowseInfo:TBrowseInfoA;
- Buffer:array [0..MAX_PATH-1] of AnsiChar;
- ItemIDList:PItemIDList;
- ShellMalloc:IMalloc;
-begin
- Result:=False;
- FillChar(BrowseInfo,SizeOf(BrowseInfo),0);
- if (ShGetMalloc(ShellMalloc)=S_OK) and (ShellMalloc<>nil) then
- begin
- with BrowseInfo do
- begin
- hwndOwner :=Parent;
- pszDisplayName:=Buffer;
- lpszTitle :=Caption;
- ulFlags :=BIF_RETURNONLYFSDIRS;
- end;
- if newstyle then
- if CoInitializeEx(nil,COINIT_APARTMENTTHREADED)<>RPC_E_CHANGED_MODE then
- BrowseInfo.ulFlags:=BrowseInfo.ulFlags or BIF_NEWDIALOGSTYLE;
- try
- ItemIDList:=ShBrowseForFolderA(BrowseInfo);
- Result:=ItemIDList<>nil;
- if Result then
- begin
- ShGetPathFromIDListA(ItemIDList,Buffer);
- StrDup(Directory,Buffer);
- ShellMalloc.Free(ItemIDList);
- end;
- finally
- if newstyle then CoUninitialize;
- end;
- end;
-end;
-
-function SelectDirectory(Caption:PWideChar;var Directory:PWideChar;
- Parent:HWND=0;newstyle:bool=false):Boolean;
-var
- BrowseInfo:TBrowseInfoW;
- Buffer:array [0..MAX_PATH-1] of WideChar;
- ItemIDList:PItemIDList;
- ShellMalloc:IMalloc;
-begin
- Result:=False;
- FillChar(BrowseInfo,SizeOf(BrowseInfo),0);
- if (ShGetMalloc(ShellMalloc)=S_OK) and (ShellMalloc<>nil) then
- begin
- with BrowseInfo do
- begin
- hwndOwner :=Parent;
- pszDisplayName:=Buffer;
- lpszTitle :=Caption;
- ulFlags :=BIF_RETURNONLYFSDIRS;
- end;
- if newstyle then
- if CoInitializeEx(nil,COINIT_APARTMENTTHREADED)<>RPC_E_CHANGED_MODE then
- BrowseInfo.ulFlags:=BrowseInfo.ulFlags or BIF_NEWDIALOGSTYLE;
- try
- ItemIDList:=ShBrowseForFolderW(BrowseInfo);
- Result:=ItemIDList<>nil;
- if Result then
- begin
- ShGetPathFromIDListW(ItemIDList,Buffer);
- StrDupW(Directory,Buffer);
- ShellMalloc.Free(ItemIDList);
- end;
- finally
- if newstyle then CoUninitialize;
- end;
- end;
-end;
-
-//----- ListView functions -----
-
-function LV_GetLParam(list:HWND;item:integer=-1):integer;
-var
- li:LV_ITEMW;
-begin
- if item<0 then
- begin
- item:=SendMessage(list,LVM_GETNEXTITEM,-1,LVNI_FOCUSED);
- if item<0 then
- begin
- result:=-1;
- exit;
- end;
- end;
- li.iItem :=item;
- li.mask :=LVIF_PARAM;
- li.iSubItem:=0;
- SendMessageW(list,LVM_GETITEMW,0,dword(@li));
- result:=li.lParam;
-end;
-
-function LV_SetLParam(list:HWND;lParam:dword;item:integer=-1):integer;
-var
- li:LV_ITEMW;
-begin
- if item<0 then
- begin
- item:=SendMessage(list,LVM_GETNEXTITEM,-1,LVNI_FOCUSED);
- if item<0 then
- begin
- result:=-1;
- exit;
- end;
- end;
- li.iItem :=item;
- li.mask :=LVIF_PARAM;
- li.lParam :=lParam;
- li.iSubItem:=0;
- SendMessageW(list,LVM_SETITEMW,0,dword(@li));
- result:=lParam;
-end;
-
-function LV_ItemAtPos(wnd:HWND;Pt:TPOINT;var SubItem:dword):Integer;
-var
- HTI:LV_HITTESTINFO;
-begin
- HTI.pt.x := Pt.X;
- HTI.pt.y := Pt.Y;
- SendMessage(wnd,LVM_SUBITEMHITTEST,0,Integer(@HTI));
- Result :=HTI.iItem;
- if @SubItem<>nil then
- SubItem:=HTI.iSubItem;
-end;
-
-function LV_ItemAtPos(wnd:HWND;x,y:integer;var SubItem:dword):Integer; overload;
-var
- HTI:LV_HITTESTINFO;
-begin
- HTI.pt.x := x;
- HTI.pt.y := y;
- SendMessage(wnd,LVM_SUBITEMHITTEST,0,Integer(@HTI));
- Result :=HTI.iItem;
- if @SubItem<>nil then
- SubItem:=HTI.iSubItem;
-end;
-
-function LV_Compare(lParam1,lParam2,param:LPARAM):integer; stdcall;
-var
- olditem,neibor:integer;
-begin
- result:=lParam1-lParam2;
- neibor :=hiword(param);
- olditem:=loword(param);
- if neibor>olditem then
- begin
- if (lParam1=olditem) and (lParam2<=neibor) then
- result:=1;
- end
- else
- begin
- if (lParam2=olditem) and (lParam1>=neibor) then
- result:=1;
- end;
-end;
-
-function LV_MoveItem(list:hwnd;direction:integer;item:integer=-1):integer;
-begin
- if ((direction>0) and (item=(SendMessage(list,LVM_GETITEMCOUNT,0,0)-1))) or
- ((direction<0) and (item=0)) then
- begin
- result:=item;
- exit;
- end;
-
- if item<0 then
- item:=SendMessage(list,LVM_GETNEXTITEM,-1,LVNI_FOCUSED);
- SendMessageW(list,LVM_SORTITEMSEX,dword(item)+(dword(item+direction) shl 16),dword(@LV_Compare));
- result:=item+direction;
-end;
-
-function LV_GetColumnCount(list:HWND):integer;
-begin
- result:=SendMessage(SendMessage(list,LVM_GETHEADER,0,0),HDM_GETITEMCOUNT,0,0);
-end;
-
-function LV_CheckDirection(list:HWND):integer;
-var
- i,cnt{,selcnt}:integer;
- stat,first,last,focus: integer;
-begin
- first :=-1;
- last :=-1;
- focus :=-1;
- cnt :=SendMessage(list,LVM_GETITEMCOUNT,0,0)-1;
-// selcnt:=SendMessage(list,LVM_GETSELECTEDCOUNT,0,0);
- for i:=0 to cnt do
- begin
- stat:=SendMessage(list,LVM_GETITEMSTATE,i,LVIS_SELECTED or LVIS_FOCUSED);
- if (stat and LVIS_SELECTED)<>0 then
- begin
- if (stat and LVIS_FOCUSED)<>0 then
- focus:=i;
- if first<0 then first:=i;
- last:=i;
- end;
- end;
- result:=0;
- if focus<0 then
- focus:=first;
- if focus>=0 then
- result:=result or ((focus+1) shl 16);
- if first>0 then // at least one selected and not first
- begin
- result:=(result or 1){ or (first+1) shl 16};
- end;
- if (last>=0) and (last<cnt) then
- result:=result or 2;
-end;
-
-//----- Combobox functions -----
-
-function CB_SelectData(cb:HWND;data:dword):integer; overload;
-var
- i:integer;
-begin
- result:=0;
- for i:=0 to SendMessage(cb,CB_GETCOUNT,0,0)-1 do
- begin
- if data=dword(SendMessage(cb,CB_GETITEMDATA,i,0)) then
- begin
- result:=i;
- break;
- end;
- end;
- result:=SendMessage(cb,CB_SETCURSEL,result,0);
-end;
-
-function CB_SelectData(Dialog:HWND;id:cardinal;data:dword):integer; overload;
-begin
- result:=CB_SelectData(GetDlgItem(Dialog,id),data);
-end;
-
-function CB_GetData(cb:HWND;idx:integer=-1):dword;
-begin
- if idx<0 then
- idx:=SendMessage(cb,CB_GETCURSEL,0,0);
- result:=SendMessage(cb,CB_GETITEMDATA,idx,0);
-end;
-
-function CB_AddStrData(cb:HWND;astr:pAnsiChar;data:integer=0;idx:integer=-1):HWND;
-begin
- result:=cb;
- if idx<0 then
- idx:=SendMessage(cb,CB_ADDSTRING,0,dword(astr))
- else
- idx:=SendMessage(cb,CB_INSERTSTRING,idx,dword(astr));
- SendMessage(cb,CB_SETITEMDATA,idx,data);
-end;
-
-function CB_AddStrDataW(cb:HWND;astr:pWideChar;data:integer=0;idx:integer=-1):HWND;
-begin
- result:=cb;
- if idx<0 then
- idx:=SendMessageW(cb,CB_ADDSTRING,0,dword(astr))
- else
- idx:=SendMessageW(cb,CB_INSERTSTRING,idx,dword(astr));
- SendMessage(cb,CB_SETITEMDATA,idx,data);
-end;
-
-end.
|