Текущий архив: 2006.06.18;
Скачать: CL | DM;

Вниз

Не могу создать TabControl, WinApi   Найти похожие ветки 

← →
Arazel ©   (2006-03-21 11:35) [0]

Не создается и все  Что я не так сделал?  

program TabControl;

uses
 windows,
 messages,
 commctrl;

var
  ScrWidth          : integer;
  ScrHeight         : integer;  

  pTabControlProc   : Pointer;
  hTabControl       : THandle;

procedure SetTrans(h:hwnd;procent:integer);
var
 old: longint;
begin
old:=GetWindowLongA(h,GWL_EXSTYLE);
 if procent>0 then begin

   SetWindowLongA(h,GWL_EXSTYLE,old or WS_EX_LAYERED);
   SetLayeredWindowAttributes(h, 0, procent, LWA_ALPHA);
 end else SetWindowLongA(h,GWL_EXSTYLE,old xor WS_EX_LAYERED);
end;

procedure HideTaskBarButton(hWindow: HWND);
var
wndTemp: HWND;
begin
wndTemp := CreateWindow("STATIC", "", WS_POPUP, 0, 0, 0, 0, 0, 0, 0, nil);
ShowWindow(hWindow, SW_HIDE);
SetWindowLong(hWindow, GWL_HWNDPARENT, wndTemp);
ShowWindow(hWindow, SW_SHOW);
end;

function TopPosition(hWin: HWND; Top: Boolean): BOOL;
var
Regim: Integer;
begin
if Top
 then Regim := HWND_TOPMOST
 else Regim := HWND_NOTOPMOST;
Result := SetWindowPos(hWin, Regim, 0, 0, 0, 0,SWP_NOMOVE or SWP_NOSIZE);
end;

function TabCtrlSubclassProc(hWnd:HWND; Msg : Integer; wParam: WPARAM; lParam: LPARAM):LRESULT; stdcall;
var
  hControlDC   : HDC;
  hMemoryDC    : HDC;
  rc           : TRECT;  // Для определения размеров окна
  hBmp         : HBITMAP; // Битмап для двойной буферизации
  hSave        : HGDIOBJ; // Оригинальный битмап из hMemoryDC
begin
{case msg of

WM_ERASEBKGND: Result:=1;
WM_PAINT:
       begin
       // Чтобы поменьше генерилось WM_ERASEBKGND, сэкономим время на
       // диспетчеризации сообщений.
      ValidateRect (hWnd, nil);
      GetClientRect (hWnd, rc); // TabControl не использует non-client area
      hControlDC := GetDC (hWnd);
      hMemoryDC := CreateCompatibleDC (hControlDC);
      hBmp := CreateCompatibleBitmap (hControlDC, rc.right, rc.bottom);
      hSave := SelectObject (hMemoryDC, hBMp);
      // Очистим буфер-битмап, зальём его фоном
      CallWindowProc (pTabControlProc, hWnd, WM_ERASEBKGND, hMemoryDC, 0);
      // Прорисуем контрол в битмапе
      CallWindowProc (pTabControlProc, hWnd, WM_PRINTCLIENT, hMemoryDC, PRF_CLIENT);
      // Ну и нарисуем контрол на дисплее
      BitBlt (hControlDC, 0, 0, rc.right, rc.bottom, hMemoryDC, 0, 0, SRCCOPY);
      DeleteObject (SelectObject (hMemoryDC, hSave));
      DeleteDC (hMemoryDC);
      ReleaseDC (hWnd, hControlDC);
      result := 0;
    end;
end;     }
Result:=CallWindowProc (pTabControlProc, hWnd, Msg, wParam, lParam);
end;

function WindowProc(wnd:HWND; Msg : Integer; wParam: WPARAM; lParam: LPARAM):LRESULT; stdcall;
begin
case msg of
 WM_NCHITTEST:  result := HTCAPTION;
 WM_COMMAND :
             begin
               case LoWord(wParam) of
                 IDCANCEL : DestroyWindow(wnd);
               end;
               result := 0;
             end;

 WM_DESTROY :
             begin
               PostQuitMessage(0);
               Result:=0;
             end;

 else Result:=DefWindowProc(wnd,msg,wParam,lParam);
end;
 TopPosition(wnd, True);
end;//of WindowProc

var
  w,h               : DWORD;
  R                 : TRect;
  tie               : TTCITEM;
  WndClassEx        : TWndClassEx;
  Handle            : HWND;
  Msg               : TMsg;

begin
  ScrWidth:=GetSystemMetrics (SM_CXSCREEN);
  ScrHeight:=GetSystemMetrics (SM_CYSCREEN);

  WndClassEx.cbSize:=sizeof(WndClassEx);
  WndClassEx.style:=CS_HREDRAW or CS_VREDRAW;
  WndClassEx.lpfnWndProc:=@WindowProc;
  WndClassEx.cbClsExtra:=0;
  WndClassEx.cbWndExtra:=0;
  WndClassEx.hInstance:=hInstance;
  WndClassEx.hIcon:=LoadIcon(0,IDI_APPLICATION);
  WndClassEx.hCursor:=LoadCursor(0,IDC_ARROW);
  WndClassEx.hbrBackground:=COLOR_BTNFACE+1;
  WndClassEx.lpszMenuName:=nil;
  WndClassEx.lpszClassName:="Class";
  RegisterClassEx(WndClassEx);

  Handle:= CreateWindowEx(WS_EX_DLGMODALFRAME,"Class", "Name", WS_POPUP or WS_VISIBLE or WS_BORDER,
  10, 10, 300, 100,0, 0,hInstance,nil);

  GetClientRect(Handle, r);
  hTabControl:=CreateWindow(WC_TABCONTROL,nil,
  WS_CHILD or WS_CLIPSIBLINGS or WS_VISIBLE,
  0, 20, 400, 40,Handle,100, hInstance, nil);

  if(hTabControl <> 0) Then
  pTabControlProc:=Pointer(SetWindowLong(hTabControl, GWL_WNDPROC,Integer(@TabCtrlSubclassProc)));
  with tie do
    begin
      mask := TCIF_TEXT or TCIF_IMAGE;
      iImage := -1;
        pszText := "ID0"; SendMessage(hTabControl, TCM_INSERTITEM, integer(0), Longint(@tie));
        pszText := "ID1"; SendMessage(hTabControl, TCM_INSERTITEM, integer(1), Longint(@tie));
        pszText := "ID2"; SendMessage(hTabControl, TCM_INSERTITEM, integer(2), Longint(@tie));
    end;

  HideTaskBarButton(Handle);
  SetTrans(Handle,230);
  ShowWindow(Handle,SW_SHOW);
  UpdateWindow(Handle);

  While GetMessage(Msg,0,0,0) do begin
  if Handle<>0 then
  if IsDialogMessage(Handle,Msg) then continue;
 TranslateMessage(Msg);
 DispatchMessage(Msg);
end;
end.

---

← →
clickmaker ©   (2006-03-21 11:39) [1]

InitCommonControls()

---

Страницы: 1 вся ветка

Текущий архив: 2006.06.18;
Скачать: CL | DM;

Наверх

Память: 0.46 MB
Время: 0.011 c