[ 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. fenixelite

    fenixelite Banned

    Joined:
    7 Feb 2010
    Messages:
    294
    Likes Received:
    56
    Reputations:
    6
    Если уж хочешь так, то сначала создай сам экземпляр класса своего(думаю, ты его не создавал, раз ошибки),
    Image := TMyClass.Create;
    и потом уже
    Image.FImage:= TMyClass.FImage.Create(nil)
     
  2. -=m@ster=-

    -=m@ster=- New Member

    Joined:
    20 Apr 2011
    Messages:
    8
    Likes Received:
    1
    Reputations:
    0
    Доброго времени суток!
    Есть два вопроса.

    1. Нужно что-то вроде CallBack-а.
    Мне нужно вызывать однотипные функции с разным количеством и типом параметров.

    Нагляднее это будет видно в коде:

    Code:
    type
      PMathFunction = ^TMathFunction;
      TMathFunction = function: Integer; stdcall;
    
    {$R *.dfm}
    
    
    function Parabala(x: Integer): Integer;
    begin
      Result := x * x;
    end;
    
    function AParabala(a, x: Integer): Integer;
    begin
      Result := a * (x * x);
    end;
    
    function Wrapper(Func: TMathFunction): Integer;
    begin
      Result := Func * 25;
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      ShowMessage(IntToStr(Wrapper(Parabala)));
    end;
    Как правильно осуществлять вызов функций типа Integer через Wrapper (разумеется с передачей параметров)?


    2. Где можно доступно почитать про сообщения.
    И где найти полный спсиок констант с префиксом WM_ ?
     
  3. GhostOnline

    GhostOnline Active Member

    Joined:
    20 Dec 2008
    Messages:
    723
    Likes Received:
    110
    Reputations:
    22
    1. С разным количеством да еще и типом параметров так не получится. Можно передавать массив нетипизированных указателей(array of Pointer), который подойдет практически подо все. С использованием приведения типов разумеется.
    Ну и, сами вызываемые функции должны "знать" как обрабатывать массив. Т.е. Parabola знает что в arr[0] лежит указатель на Integer, и считывает по указателю значение.

    2. Хорошая статья про сообщения
    Список можно посмотреть в модуле Messages, а описание констант в МСДН конечно же.
     
  4. -=m@ster=-

    -=m@ster=- New Member

    Joined:
    20 Apr 2011
    Messages:
    8
    Likes Received:
    1
    Reputations:
    0
    Начал пробовать - ничего не получилось.
    А можете показать пример с передачей параметров функцие.
     
  5. GhostOnline

    GhostOnline Active Member

    Joined:
    20 Dec 2008
    Messages:
    723
    Likes Received:
    110
    Reputations:
    22
    Code:
    type
      TMathFunc = function(arr: array of Pointer): Integer;
    
      // фукция вычисления суммы 2 чисел, подразумевается что слагаемые это 2 первых элемента массива 
      function Add(arr: array of Pointer): Integer;
      begin
        Result := PInteger(arr[0])^ + PInteger(arr[1])^;
      end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
      func: TMathFunc;
      arr: array of Pointer;
      x, y: Integer;
    begin
     func := Add;
     x := 1;
     y := 2;
     SetLength(arr, 2);
     arr[0] := @x;
     arr[1] := @y;
     Caption :=  IntToStr(func(arr));
    end;
    Вариант #2, с передачей открытого массива:
    Code:
    var
       ints : array[1..2] of Integer = (7, 8);
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
      func: TMathFunc;
    begin
     func := Add;
     Caption :=  IntToStr(func([@ints[1] , @ints[2]]));
    end;
     
    #8165 GhostOnline, 26 Apr 2011
    Last edited: 26 Apr 2011
  6. -=m@ster=-

    -=m@ster=- New Member

    Joined:
    20 Apr 2011
    Messages:
    8
    Likes Received:
    1
    Reputations:
    0
    Это понятно.
    А если через Wrapper.
    Вот как передавать параметры Wrapper-у?
    С функцией то всё понятно.
     
  7. GhostOnline

    GhostOnline Active Member

    Joined:
    20 Dec 2008
    Messages:
    723
    Likes Received:
    110
    Reputations:
    22
    Кхм, не вижу никаких трудностей...

    function Wrapper(func: TMathFunction; args: array of Pointer): Integer;
    begin
    Result := func(args);
    end;
     
  8. -=m@ster=-

    -=m@ster=- New Member

    Joined:
    20 Apr 2011
    Messages:
    8
    Likes Received:
    1
    Reputations:
    0
    Всё.
    Спасибо.
    Ошибка была в использовании stdcall;

    Вот что я скодил:

    Code:
    type
      TMathFunc = function(parms: Array of Double): Double;
    
    {$R *.dfm}
    
    function Wrapper(f: TMathFunc; parms: Array of Double): Integer;
    begin
      Result := round(f(parms) * 25);
    end;
    
    function Parabala(parms: Array of Double): Double;
    begin
      Result := parms[0] * (parms[1]*parms[1]);
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      ShowMessage(IntToStr(Wrapper(Parabala, [1, 2])));
    end;
     
  9. MaTpOc

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

    Joined:
    5 May 2008
    Messages:
    633
    Likes Received:
    475
    Reputations:
    25
    помогите приделать прoцедуру подсчета симвoлов в cтрoке без прoбелов к кнопке "ВЫПОЛНИТЬ"

    +еще нужнo сделать чтобы кoгда пишешь "ввв" был подсчет этих букв и вывoд в поле.



    PHP:
    unit Unit1;

    interface

    uses
      Windows
    MessagesSysUtilsVariantsClassesGraphicsControlsForms,
      
    DialogsStdCtrls;

    type
      TForm1 
    = class(TForm)
        
    Button1TButton;
        
    Edit1TEdit;
        
    Label1TLabel;
        
    CheckBox1TCheckBox;
        
    CheckBox2TCheckBox;
        
    CheckBox3TCheckBox;
        
    Edit2TEdit;
        
    Label2TLabel;
        
    Edit3TEdit;
        
    Label3TLabel;
        
    procedure Button1Click(SenderTObject);
    //    procedure FormCreate(Sender: TObject);
    //    procedure Edit1Change(Sender: TObject);
    //    procedure CheckBox1Click(Sender: TObject);

    //    procedure CheckBox2Click(Sender: TObject);
        //procedure CheckBox2Click(Sender: TObject);
    //    procedure CheckBox3Click(Sender: TObject);
    //    procedure Label1Click(Sender: TObject);
      //  procedure Label1Click(Sender: TObject);
    //    procedure Edit2Change(Sender: TObject);
    //    procedure Label2Click(Sender: TObject);
       // procedure Label2Click(Sender: TObject);
    //    procedure Label3Click(Sender: TObject);
      
    private
        { Private 
    declarations }
      public
        { Public 
    declarations }
      
    end;

    var
      
    Form1TForm1;

    implementation

    {$R *.dfm}

    procedure TForm1.Button1Click(SenderTObject); //начало процедуры
    var
     
    S:string;
     
    N:byte;

    begin
     N
    :=0;
     
    Edit3.Text:='';
     
    Edit2.Text:='';
     
    S:=Edit1.Text;

     if 
    CheckBox2.Checked then //замена букв а на б
       
    while Pos('а',S)>do
         
    begin
          N
    :=N+1;
          
    S[Pos('а',S)]:='б';
         
    end;

     if 
    CheckBox3.Checked then  //замена пробелов на тире
       
    while Pos(' ',S)>do
         
    begin
          N
    :=N+1;
          
    S[Pos(' ',S)]:='-'
         
    end;

     if 
    CheckBox1.Checked then //вывод числа замен и изменненного текста в поле
       
    Edit3.Text:=IntToStr(N);
       
    Edit2.Text:=S;

         
    end;

    end.
     
  10. solo

    solo New Member

    Joined:
    16 Apr 2011
    Messages:
    27
    Likes Received:
    0
    Reputations:
    0
    finally
    end;

    тоже самое что и

    begin
    end;

    или всё же нет?
     
  11. MaTpOc

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

    Joined:
    5 May 2008
    Messages:
    633
    Likes Received:
    475
    Reputations:
    25
    нет

    финали вообще не обязательный пункт
     
  12. -=m@ster=-

    -=m@ster=- New Member

    Joined:
    20 Apr 2011
    Messages:
    8
    Likes Received:
    1
    Reputations:
    0
    Друзья, подскажите, чтобы я бошку долго не бил.
    Пишу визуальную компоненту для рисования граффиков.
    Наследую всё хороше от TImage.
    Вопрос вот в чём, когда визуально TImage ресайзешь в проектировании формы, какое событие генерит система?
    Мне бы его поймать, да сделать так, чтобы мой компонент тоже перерисовывался под новую высоту и ширину.
     
  13. alexey-m

    alexey-m Elder - Старейшина

    Joined:
    15 Jul 2009
    Messages:
    518
    Likes Received:
    100
    Reputations:
    37
    -=m@ster=-,сообщение WM_SIZE посылается окну после того, как его размер изменился.
     
  14. solo

    solo New Member

    Joined:
    16 Apr 2011
    Messages:
    27
    Likes Received:
    0
    Reputations:
    0
    Помогите с Delphi
    Нужно програмно на сайте vceti.by добавить человека в друзья..
    Набросал код. Прохожу авторизацию, а заявка не отправляется
    Вот код, подскажите что не так

    Code:
    procedure TForm1.Button1Click(Sender: TObject);
    var http:TIdHTTP; cook:TIdCookieManager; s, a:TStringList; resp, friends:string;
    begin
      http:=TIdHTTP.Create(nil);
      cook:=TIdCookieManager.Create(nil);
      http.CookieManager:=cook;
      http.HandleRedirects:=true;
      http.AllowCookies:=true;
      s:=TStringList.Create;
      s.Add('op=a_login_attempt');
      s.Add('email='+Edit1.Text);
      s.Add('pass='+Edit2.Text);
      s.Add('expire=0');
      try
      resp:=http.Post('http://vseti.by/login.php', s);
      Form1.Caption:=(resp);
      if pos('good', resp)>0 then
      begin
      resp:=http.Get('http://vceti.by/friends_ajax.php?act=accept_friend&fid=ТУТ_ИД_ЖЕРТВЫ&hash=ТУТ_ХЭШ&cats=&verbose=1&message=ТЕКСТ');
      end;
      except
      end;
      http.Free;
      cook.Free;
      s.Free;
    end;
    
     
  15. #Smith

    #Smith New Member

    Joined:
    20 Jun 2010
    Messages:
    96
    Likes Received:
    2
    Reputations:
    0
    solo, за тебя твой код никто писать не будет (по крайней мере бесплатно).
    Из своего опыта скажу, что юзать indy - не лучшее решение.
    Как правило, для выполнения подобных задач тебе необходимо проснифать траффик,
    выявить ключевые запросы, попробовать отработать каждый из них руками.
    Методом научного тыка ты можешь отсеить лишние параметры.
    После того, как ты убедился, что всё правильно работает - встраиваешь свои наработки в код проекта и двигаешься дальше.


    Что касается твоего вопроса - опять же сниффер тебе в руки.
    Снифаешь оригинальные запросы и снифаешь свои.
    Потом находишь десять отличий и разбираешься что не так, где не так и почему.
     
    #8175 #Smith, 30 Apr 2011
    Last edited: 30 Apr 2011
  16. solo

    solo New Member

    Joined:
    16 Apr 2011
    Messages:
    27
    Likes Received:
    0
    Reputations:
    0
    Разве я просил писать за меня код? Он уже написан, выложил в урезаном виде.. Я лишь попросил показать место где допущена мною ошибка. Со снифером я уже пороботал, все необходимые мне запросы выявил и перебрал их вручную через браузер. Всё работает, а вот програмно не получается. Авторизацию прохожу успешно но жертву в друзья добавить не получается..

    По прежнему надеюсь на вашу помощь...

    > #Smith, прислушался к твоему совету и в качестве благодарности тому кто поможет даю 10 голосов (вконтакте). Мой профиль: http://vkontakte.ru/solo555
     
    #8176 solo, 30 Apr 2011
    Last edited: 30 Apr 2011
  17. winlogon.exe

    winlogon.exe Active Member

    Joined:
    5 Jun 2009
    Messages:
    31
    Likes Received:
    129
    Reputations:
    13
    делаю post запрос..
    выходит вот такая ошибка.. не знаю даже что может быть
    [​IMG]





    может так
    if pos('good', resp) <> 0 then
    ?
     
    #8177 winlogon.exe, 2 May 2011
    Last edited: 2 May 2011
  18. patcher

    patcher Banned

    Joined:
    15 Dec 2009
    Messages:
    190
    Likes Received:
    37
    Reputations:
    10

    покажи код, а то как пальцем в небо

     
  19. MaTpOc

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

    Joined:
    5 May 2008
    Messages:
    633
    Likes Received:
    475
    Reputations:
    25
    помогите сделать плиз задание!

    В квадратной матрице поменять местами строку, имеющую отрицательный элемент на главной диагонали , со столбцом, начинающимся с нуля
     
  20. winlogon.exe

    winlogon.exe Active Member

    Joined:
    5 Jun 2009
    Messages:
    31
    Likes Received:
    129
    Reputations:
    13
    Code:
    procedure TForm1.Button2Click(Sender: TObject);
    var
    ss: String;
    d,s:string;
    Dat  : TStringList;
    
    begin
    label9.Caption:=inttostr(i);
    
        idhttp1.HandleRedirects := true;
        idhttp1.Request.Host:='vkontakte.ru';
        idhttp1.Request.UserAgent:='Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.10) Gecko/2009042316 Firefox/3.0.10';
        idhttp1.Request.Accept:='text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
        idhttp1.Request.AcceptLanguage:='ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3';
        idhttp1.Request.ContentType:='application/x-www-form-urlencoded; charset=UTF-8';
        idhttp1.Request.AcceptCharSet:='windows-1251,utf-8;q=0.7,*;q=0.7';
        idhttp1.Request.ContentLength:=107;
        idhttp1.Request.Referer:='http://vkontakte.ru/gifts.php?to=ИД';
        idhttp1.Request.CustomHeaders.Text:='Cookie: remixchk=5; remixhidden_gifts=40; remixclosed_tabs=64512; remixsid='+cook;
    
        Dat := TStringList.Create;
        Dat.Add('giftNumber=394');
        Dat.Add('hash='+str);
        Dat.Add('to_users=ИД');
        Dat.Add('to_users_custom=');
        Dat.Add('giftType=0');
        Dat.Add('giftText=');
        Dat.Add('act=do_send');
    
    
    
    s:=idhttp1.post('http://vkontakte.ru/gifts.php', dat);
    
      if pos ('error',s) <> 0 then
      log:='Подарка нету'
      else
      if pos ('captcha',s) <> 0 then
      log:='Капча'
      else
      if pos ('успешно',s) <> 0 then begin
      log:='Подарок успешно отправлен';
      ok:=ok+1;
      end;
    
    memo2.Lines.Add(log);
      idhttp1.free;
      dat.Free;
    sleep(5000);
    
    i:=i+1;            //добавляет значение для цикла
    
    label6.Caption:=inttostr(ok);
    label9.Caption:=inttostr(i);
    
    
    
    end;
    
     
    2 people like this.
Thread Status:
Not open for further replies.