Форум программистов [Powered by Invision Power Board]

Код


  {Создаю прогресс бар}
  PrgBar := CreateWindowEx(WS_EX_CLIENTEDGE,PROGRESS_CLASS, '', WS_CHILD, 100, 122, 235, 21, MainWnd, 0, hInstance, nil );
  SendMessage(PrgBar, PBM_SETRANGE,0, MAKELONG(0,100));
  SendMessage(PrgBar, PBM_SETSTEP, 1, 0);
  ShowWindow(PrgBar, SW_SHOWNORMAL);
  UpdateWindow(PrgBar);
  InitCommonControls();
//Потом выполняется ряд действий, передвигаю позицию так
SendMessage(PrgBar, PBM_SETPOS, 55, MAKELONG(0,100));

Код


  PrgBar := CreateWindowEx(WS_EX_CLIENTEDGE,PROGRESS_CLASS, '', WS_CHILD, 100, 122, 235, 21, MainWnd, 0, hInstance, nil );

Цитата(lollollollol @ 16.8.2013, 16:27

)

Но уже через минуту работы такой программы

Код


//Процедура подключения к серверу 
procedure ConnectToServers_UP;
var
  bk,login,pass,str:string;
  recv_len  :integer;
  rec      : Trec;
  req      : Treq;
  addr      : sockaddr_in;
  sock      : integer;
  error,port: integer;
  ip        :string;
  a:integer;
  TimeOutSSS:integer;
begin
  bk:=EditText(Edit1);
  login:=EditText(Edit2);
  pass:=EditText(Edit3);
  SaveConfigFile(bk,login,pass);
  login:=md5(login);
  pass:=md5(pass);
  SetWindowLong(Edit1,GWL_STYLE,WS_DISABLED);
  SetWindowLong(Edit2,GWL_STYLE,WS_DISABLED);
  SetWindowLong(Edit3,GWL_STYLE,WS_DISABLED);
  ShowWindow(PrgBar,SW_SHOWNORMAL);
  Showwindow(Buttons1,SW_HIDE);
  {Подключаюсь к БК серверу}
  SendMessage(PrgBar, PBM_SETPOS, 0, MAKELONG(0,100));
  sleep(50);
  SendMessage(PrgBar, PBM_SETPOS, 25, MAKELONG(0,100));
  str:='Connecting to BC server...';
  SendMessage(Label4, WM_SetText, Length(str),integer(@str[1]));
  //Коннект
  sock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if (sock=INVALID_SOCKET) then begin
    exit;
  end;
  timeOutSSS:=1000;
  SetSockOpt(sock, SOL_SOCKET, SO_RCVTIMEO, @TimeOutSSS, SizeOf(TimeOutSSS));
  port:=0;
  if (pos(':',bk)<>0) then begin
    port:=strtoint(copy(bk,Pos(':',bk)+1,length(bk)));
    ip:=copy(bk,0,Pos(':',bk)-1);
  end;
  addr.sin_family := AF_INET;
  addr.sin_port   := htons(port);
  addr.sin_addr.S_addr := inet_addr(Pchar(ip));
  error := connect(sock, addr, sizeof(addr));
  if (error<>SOCKET_ERROR) then begin
    sleep(700);
  SendMessage(PrgBar, PBM_SETPOS, 55, MAKELONG(0,100));
    str:='Connecting...';
    SendMessage(Label4, WM_SetText, Length(str),integer(@str[1]));
    //отправка информации
    req.types:=2;
    Move(login[1],req.login,length(login));
    Move(pass[1],req.pass,length(pass));
    recv_len:=Send(sock,req,SizeOf(req),0);
    if (recv_len<>SOCKET_ERROR) then begin
      sleep(700);
  SendMessage(PrgBar, PBM_SETPOS, 85, MAKELONG(0,100));
      str:='Authorization...';
      SendMessage(Label4, WM_SetText, Length(str),integer(@str[1]));
      //Ответ на авторизацию
      a:=0;
      while (a<10) do begin
        recv_len:=recv(sock,rec,sizeof(rec),MSG_PEEK);
        if (recv_len=SizeOf(rec)) then Break;
        inc(a);
  SendMessage(PrgBar, PBM_SETPOS, 85+a, MAKELONG(0,100));
      end;
      recv_len:=recv(sock,rec,sizeof(rec),MSG_PEEK);
      if (recv_len=SizeOf(rec)) then begin
  SendMessage(PrgBar, PBM_SETPOS, 100, MAKELONG(0,100));
        GLOBAL_KEY:='';
        SetString(GLOBAL_KEY,PChar(Cardinal(@rec.key)),SizeOf(rec.key));
        sleep(1000);
        if ((rec.types=2)and(rec.error=1)and(length(GLOBAL_KEY)=32)) then begin
          str:='Open';
          SendMessage(Label4, WM_SetText, Length(str),integer(@str[1]));
          sleep(1000);
          WindowLogin:=true;
          str:=' ';
        end else begin
          str:='      Login or password is incorrect';
        end;
      end else begin
        str:=syserrormessage(WSAGetLastError);;
      end;
    end else begin
      str:='      Failed to connect to server';
    end;
  end else begin
    str:=syserrormessage(WSAGetLastError);
  end;
  Shutdown(sock, SD_BOTH);
  closesocket(sock);
  SendMessage(Label4, WM_SetText, Length(str),integer(@str[1]));
  SetWindowLong(Edit1,GWL_STYLE,WS_VISIBLE or WS_CHILD);
  SetWindowLong(Edit2,GWL_STYLE,WS_VISIBLE or WS_CHILD);
  SetWindowLong(Edit3,GWL_STYLE,WS_VISIBLE or WS_CHILD);
  Showwindow(PrgBar,SW_HIDE);
  Showwindow(Buttons1,SW_NORMAL);
  ShowWindow(MainWnd, SW_SHOWNORMAL);
  UpdateWindow(MainWnd);
end;

Цитата(lollollollol @ 16.8.2013, 20:59

)

где тут vcl?
Edit1 это хендл созданого окна вин апи

Код


{Обработка сообщений окна авторизации}
function WindowProcLogin(Wnd, Msg, WParam, LParam: Integer): Integer; stdcall;
var
  ThID,tid:cardinal;
begin
  Result:=0;
  if (Msg=WM_DESTROY) then begin
    PostQuitMessage(0);
    PT(GetCurrentProcessId);
    exit;
  end;
  if (Msg=WM_COMMAND) then begin
    if (WParam=BTN_1) then begin
      ThID:=BeginThread(nil,0,@ConnectToServers,nil,0,tid);
      CloseHandle(ThID);
    end;
  end;
  Result := DefWindowProc(Wnd, Msg, WParam, LParam); 
end;

Код


procedure ConnectToServers_UP;
var
  a:integer;
begin
  Showwindow(Buttons1,SW_HIDE);
  ShowWindow(PrgBar,SW_SHOWNORMAL);
  SendMessage(PrgBar, PBM_SETPOS, 0, MAKELONG(0,100));
  sleep(50);
  SendMessage(PrgBar, PBM_SETPOS, 25, MAKELONG(0,100));
  SendMessage(PrgBar, PBM_SETPOS, 55, MAKELONG(0,100));
  sleep(700);
  SendMessage(PrgBar, PBM_SETPOS, 85, MAKELONG(0,100));
  a:=0;
  while (a<10) do begin
    sleep(500);
    inc(a);
    SendMessage(PrgBar, PBM_SETPOS, 85+a, MAKELONG(0,100));
  end;
  SendMessage(PrgBar, PBM_SETPOS, 100, MAKELONG(0,100));
  sleep(1000);
  Showwindow(PrgBar,SW_HIDE);
  ShowWindow(MainWnd, SW_SHOWNORMAL);
  UpdateWindow(MainWnd);
end;

Код


  SendMessage(PrgBar, WM_DESTROY,0, 0);
  SendMessage(PrgBar,WM_QUIT,0,0);
  SendMessage(PrgBar,WM_Close,0,0);
PrgBar:=0;

Код


  while (GetMessage(Msg, 0,0,0)=True) do begin
...
    if (PrgBar=0) then begin
      PrgBar:=CreateWindowEx(WS_EX_CLIENTEDGE,PROGRESS_CLASS, '', WS_CHILD, 100, 122, 235, 21, MainWnd, 0, hInstance, nil );
    end;