Create Form

unit CreateForm_;

interface

uses
  Windows,commctrl,Messages,SysUtils,
  _Form,
  Def;

  Procedure BeginFM;
  //Objetos
  Function CreateButton  (Nome: PwideChar; X, Y, Altura,Largura : Integer): HWND;
  Function CreateEdit    (Text: PwideChar; X, Y, Altura,Largura : Integer): HWND;
  Function CreateMemo    (Text: PwideChar; X, Y, Altura,Largura : Integer): HWND;
  Function CreateLabel   (Text: PwideChar; X, Y, Altura,Largura : Integer): HWND;
  Function CreateCheckBox(Text: PwideChar; X, Y, Altura,Largura : Integer): HWND;
  Function CreateGroup   (Text: PwideChar; X, Y, Altura,Largura : Integer): HWND;
  Function CreateComboBox(Text: PwideChar; X, Y, Altura,Largura : Integer): HWND;
  Function CreateRadBT   (Text: PwideChar; X, Y, Altura,Largura : Integer): HWND;
  Function CreateProgressBar(Nome: PwideChar; X, Y, Altura,Largura : Integer): HWND;
  Function CreateTabSet     (Nome: PwideChar; X, Y, Altura,Largura : Integer): HWND;
  function CriaToolTip      (TipoIcone : Integer; Titulo : PChar) : HWND;
  Procedure AdicionaToolTip (Window, ToolTip: HWND;Texto: PChar);
  ///
  Function CreateFonte (Fonte:PwideChar;Size : Integer): HWND;
  Function CreateForm  (Caption,Classe,Fonte,FSize: PwideChar; X, Y, Altura,Largura : Integer): HWND;
  function WindowProc  (hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM):LRESULT; stdcall;
  ///Funções
  function  TComboBoxStrings(Handle:HWND;S: string): Integer;
  function  AddTab          (sCaption: string; iIndex: Integer; wnd: HWND): boolean;
  ///

implementation

uses
  hooks;

function CriaToolTip(TipoIcone : Integer; Titulo : PChar) : HWND;
begin
// Cria a janela balão
  Result := CreateWindowEx(0, 'Tooltips_Class32', nil,
    TTS_ALWAYSTIP or TTS_BALLOON, Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT),Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), MHandle, 0, hInstance, nil);
// Traz a janela para a frente
  if Result <> 0 then begin
    SetWindowPos(Result, HWND_TOPMOST, 0, 0, 0, 0,
      SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
    // Configura o título e ícone da dica
    if (TipoIcone > 3) or (TipoIcone < 0) then
      TipoIcone:= 0;
    SendMessage(Result, TTM_SETTITLE, TipoIcone,
        Integer(Titulo));
  end;
end;

procedure AdicionaToolTip(Window, ToolTip: HWND;Texto: PChar);
var
 Rect: TRect;
 ti: TToolInfo;
begin
  if (Window <> 0) then begin
    GetClientRect(Window, Rect);
// Preenche a estrutura TToolInfo
    FillChar(Ti,Sizeof(TToolInfo),0);
    ti.cbSize := SizeOf(TToolInfo);
    ti.uFlags :=  TTF_SUBCLASS;
    ti.hInst := hInstance;
    ti.hwnd := Window;
    ti.Rect := Rect;
    ti.lpszText := Texto;
// Atribui a dica
    SendMessage(ToolTip, TTM_ADDTOOL, 0, Integer(@ti));
  end;
end;

function TComboBoxStrings(Handle:HWND; S: string): Integer;
var
  EmptyStr: Char;
  LString: string;
  LPStr: LPARAM;
begin
  if S = '' then
  begin
    EmptyStr := #0;
    LPStr := LPARAM(@EmptyStr)
  end
  else
  begin
    LString := S;
    UniqueString(LString);
    LPStr := LPARAM(LString);
  end;
  Result := SendMessage(Handle, CB_ADDSTRING, 0, LPStr);
end;

function AddTab(sCaption: string; iIndex: Integer; wnd: HWND): boolean;
var
  aTabItem : TC_ITEM;
begin
  with aTabItem do
  begin
   mask := TCIF_TEXT or TCIF_IMAGE;
   iImage := -1;
   pszText :=  PWideChar(sCaption);
  end;
  Result := SendMessage(wnd, TCM_INSERTITEM, iIndex, Integer(@aTabItem)) <> -1;
end;

procedure ReleaseResources;
Var
I: INTEGER;
begin
 for I := 0 to 50 do
 begin
  DestroyWindow(TButton[I]);
  DestroyWindow(TLabel[I]);
  DestroyWindow(TEdit[I]);
 end;
  DeleteObject(hFontText);
  DeleteObject(hFontButton);
  PostQuitMessage(0);
  ExitProcess(0);
end;

Function CreateButton(Nome: PwideChar; X, Y, Altura,Largura : Integer): HWND;
begin
   Result:= CreateWindow('Button',Nome, WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT, X,Y,Altura,Largura,MHandle,0,hInstance,nil);
   SendMessage(Result,WM_SETFONT,hFontButton,0);
end;

Function CreateProgressBar(Nome: PwideChar; X, Y, Altura,Largura : Integer): HWND;
begin
   Result:= CreateWindow('msctls_progress32', Nome, WS_CHILD or WS_VISIBLE, X,Y,Altura,Largura,MHandle,0,hInstance,nil);
   SendMessage(Result,WM_SETFONT,hFontButton,0);
end;

Function CreateTabSet(Nome: PwideChar; X, Y, Altura,Largura : Integer): HWND;
var
  aRect : TRect;
  myFont : HWND;
begin
   Result := CreateWindow(WC_TABCONTROL, Nome,WS_CHILD or WS_CLIPSIBLINGS or WS_VISIBLE,X, Y, Altura, Altura,MHandle,0,hInstance,nil);
  if (Result <> 0) then
  begin
    AddTab(Nome, 0, Result);
    AddTab(Nome, 1, Result);
    AddTab(Nome, 2, Result);
  end;
   SendMessage(Result,WM_SETFONT,hFontButton,0);
end;

Function CreateLabel(Text: PwideChar; X, Y, Altura,Largura : Integer): HWND;
begin
   Result:= CreateWindow('Static',Text, WS_VISIBLE or WS_CHILD or SS_LEFT, X,Y,Altura,Largura,MHandle,0,hInstance,nil);
   SendMessage(Result,WM_SETFONT,hFontText,0);
end;

Function CreateEdit(Text: PwideChar; X, Y, Altura,Largura : Integer): HWND;
begin
   Result:= CreateWindowEx(WS_EX_CLIENTEDGE,'Edit',Text, WS_VISIBLE or WS_CHILD or ES_LEFT or ES_AUTOHSCROLL,X,Y,Altura,Largura,MHandle,0,hInstance,nil);
   SendMessage(Result,WM_SETFONT,hFontText,0);
end;

Function CreateMemo(Text: PwideChar; X, Y, Altura,Largura : Integer): HWND;
begin
   Result:= CreateWindowEx(WS_EX_CLIENTEDGE,'Edit',Text,WS_CHILD OR WS_VISIBLE OR ES_AUTOHSCROLL OR ES_NOHIDESEL OR ES_MULTILINE,X,Y,Altura,Largura,MHandle,0,hInstance,nil);
   SendMessage(Result,WM_SETFONT,hFontText,0);
end;

Function CreateCheckBox(Text: PwideChar; X, Y, Altura,Largura : Integer): HWND;
begin
  Result:=  CreateWindowEx(0, 'Button', Text, WS_CHILD or WS_VISIBLE or BS_AUTOCHECKBOX, X,Y,Altura,Largura,MHandle,0,hInstance,nil);
  SendMessage(Result,WM_SETFONT,hFontText,0);
end;

Function CreateGroup(Text: PwideChar; X, Y, Altura,Largura : Integer): HWND;
begin
  Result:=  CreateWindowEx(0, 'Button', Text, WS_CHILD or WS_VISIBLE or WS_CLIPCHILDREN or BS_GROUPBOX, X,Y,Altura,Largura,MHandle,0,hInstance,nil);
  SendMessage(Result,WM_SETFONT,hFontText,0);
end;

Function CreateRadBT(Text: PwideChar; X, Y, Altura,Largura : Integer): HWND;
begin
  Result:=  CreateWindowEx(0, 'Button','Byte', WS_CHILD or WS_VISIBLE or BS_AUTORADIOBUTTON or BS_FLAT , X,Y,Altura,Largura,MHandle,0,hInstance,nil);
  SendMessage(Result,WM_SETFONT,hFontText,0);
end;

Function CreateComboBox(Text: PwideChar; X, Y, Altura,Largura : Integer): HWND;
begin
  Result:= CreateWindowEx(0,'COMBOBOX',Text,WS_VISIBLE or WS_CHILD or CBS_AUTOHSCROLL OR CBS_DROPDOWNLIST OR CBS_HASSTRINGS OR CBS_SORT OR CBS_UPPERCASE, X,Y,Altura,Largura,MHandle,0,hInstance,nil);
  SendMessage(Result,WM_SETFONT,hFontText,0);
end;

Function CreateForm(Caption,Classe,Fonte,FSize: PwideChar; X, Y, Altura,Largura : Integer): HWND;
begin
  TClass.hInstance := hInstance;
  with TClass do
    begin
      lpszClassName := Classe;
      Style         := CS_PARENTDC or CS_BYTEALIGNCLIENT;
      hIcon         := LoadIcon(0, IDI_APPLICATION);
      lpfnWndProc   := @WindowProc;
      hbrBackground := COLOR_BTNFACE+1;
      hCursor       := LoadCursor(0,IDC_ARROW);
    end;
  RegisterClass(TClass);
  Result := CreateWindow(TClass.lpszClassName,Caption, WS_CAPTION or WS_MINIMIZEBOX or WS_SYSMENU or WS_VISIBLE, X, Y, Altura,Largura,0,0,hInstance,nil);
  hFontText   := CreateFonte(Fonte,StrToInt(FSize));
  hFontButton := CreateFonte(Fonte,StrToInt(FSize));
  SetWindowPos(Result, HWND_TOPMOST, X, Y, Altura, Largura, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
end;

Function CreateFonte(Fonte:PwideChar;Size : Integer): HWND;
begin
 Result:= CreateFont(Size*2-1,     // Height
    Size*2-10,                     // Width
    0,                             // Angle of Rotation
    0,                             // Orientation
    0,                             // Weight
    0,                             // Italic
    0,                             // Underline
    0,                             // Strike Out
    DEFAULT_CHARSET,               // Char Set
    OUT_DEFAULT_PRECIS,            // Precision
    CLIP_DEFAULT_PRECIS,           // Clipping
    DEFAULT_QUALITY,               // Render Quality
    DEFAULT_PITCH or FF_DONTCARE,  // Pitch & FamilyFonte);
    Fonte);
end;

function WindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM):LRESULT; stdcall;
Var
Text : PwideChar;
begin
  case uMsg of
  WM_COMMAND: CMD(lParam);   //controle

  end;
  Result:=DefWindowProc(hWnd,uMsg,wParam,lParam);
end;

Procedure BeginFM;
begin
  MHandle    := CreateForm('Polaris','BAD','Tahoma','8',125,125,253,168);

 TEdit[0]   := CreateEdit('',88,20,129,21);
  TEdit[1]   := CreateEdit('100',16,96,49,21);
  TButton[0] := CreateButton('NAME',8,8,65,33);
  TButton[1] := CreateButton('NAME1',88,84,49,33);
  TButton[2] := CreateButton('NAME2',168,84,49,33);
  TCB[3]   := CreateCheckBox('NAME3',16,72,57,17);
  TCB[7]   := CreateCheckBox('NAME4',16,48,57,17);


    while GetMessage(Msg,0,0,0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end;


end.