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

    mailbrush Well-Known Member

    Joined:
    24 Jun 2008
    Messages:
    1,997
    Likes Received:
    996
    Reputations:
    155
    НTL, в uses подключай юнит другой формы.

    Как окурглить рамку (контур) кнопки?
     
  2. Rebit

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

    Joined:
    7 Aug 2007
    Messages:
    85
    Likes Received:
    214
    Reputations:
    2
    Нада человек який решить задачки 1-курсу института

    Задача типа


    С меня плюсики + благодарность

    Заданий много то стучите все и при цьом задания разних типов


    Актуально
     
  3. НTL

    НTL Elder - Старейшина

    Joined:
    26 Jan 2008
    Messages:
    715
    Likes Received:
    205
    Reputations:
    -26
    mailbrush, 3 вкладка, последний компонент, XP... Просто на форму ее кинь
     
    1 person likes this.
  4. Zitt

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

    Joined:
    7 May 2006
    Messages:
    736
    Likes Received:
    268
    Reputations:
    59
    Как распечатать текст в определенном месте на листе?
    например в углах листа...
     
  5. Flame of Soul

    Flame of Soul Elder - Старейшина

    Joined:
    25 May 2007
    Messages:
    185
    Likes Received:
    146
    Reputations:
    45
    Реализация:
    PHP:
    procedure LFD(PathstringFileListTStrings);
    var
      
    SRTSearchRec;
      
    ATInteger;
      
    STString;
    begin
      
    if FindFirst(Path '*.*'faAnyFileSR) = 0 then
      begin
      repeat
        
    if DirectoryExists(path+SR.Namethen
        begin
          ST 
    :='Folder';
          
    AT := FileGetAttr(path+SR.Name);
          if (
    AT and faHidden)  <> 0 then ST := ST 'H'//Hidden
          
    if (AT and faReadOnly)<> 0 then ST := ST 'R'//Read-Only
          
    if (AT and faSysFile) <> 0 then ST := ST 'S'//System
          
    if (AT and faArchive) <> 0 then ST := ST 'A'//Archive
          
    ST:=ST+'] ';
          
    FileList.Add(' [' ST SR.Name ' [/'+ST);
        
    end
        
    else
        
    begin
          ST 
    :='File';
          
    AT := FileGetAttr(path+SR.Name);
          if (
    AT and faHidden)  <> 0 then ST := ST 'H'//Hidden
          
    if (AT and faReadOnly)<> 0 then ST := ST 'R'//Read-Only
          
    if (AT and faSysFile) <> 0 then ST := ST 'S'//System
          
    if (AT and faArchive) <> 0 then ST := ST 'A'//Archive
          
    ST:=ST+'] ';
          
    FileList.Add(' [' ST SR.Name ' [/'+ST);
        
    end
        until FindNext
    (SR) <> 0;
        
    FindClose(SR);
      
    end;
    end;
    Пример вызова:
    PHP:
    procedure TForm1.Button1Click(SenderTObject);
    begin
      LFD
    ('c:\',Memo1.Lines);
    end;
     
    1 person likes this.
  6. НTL

    НTL Elder - Старейшина

    Joined:
    26 Jan 2008
    Messages:
    715
    Likes Received:
    205
    Reputations:
    -26
    как сделать кнопку "Обзор" (Файлов)
    Да еще чтобы под "Имя файла" было "Тип файла" тыпы который я должен указать сам...

    ПСы: Гугол седня играет не в мою пользу :(
     
  7. Flame of Soul

    Flame of Soul Elder - Старейшина

    Joined:
    25 May 2007
    Messages:
    185
    Likes Received:
    146
    Reputations:
    45
    если на Дельфи, то вкладка Dialog -> добавляешь на форму OpenDialog
    открываешь в свойствах Filter у OpenDialog и там 2 колонки, так вот в первую пишешь что хочешь, а во вторую маску файлов.

    [​IMG]
    Потом обработчик:

    PHP:
    procedure TForm1.Button1Click(SenderTObject);
    var
      
    sstring;
    begin
     
    if OpenDialog1.Execute then s:=OpenDialog1.FileName;
    end;
     
  8. НTL

    НTL Elder - Старейшина

    Joined:
    26 Jan 2008
    Messages:
    715
    Likes Received:
    205
    Reputations:
    -26
    Все работате, но теперь как перехватить путь и имя файла и закинуть это в эдит1 (например: выбрали мы фаил и он записался в эдит1 в таком виде: c:\папка\папка\еще одна папка\фаил.txt
     
  9. Flame of Soul

    Flame of Soul Elder - Старейшина

    Joined:
    25 May 2007
    Messages:
    185
    Likes Received:
    146
    Reputations:
    45
    PHP:
     procedure TForm1.Button1Click(SenderTObject);
    var
      
    sstring;
    begin
     
    if OpenDialog1.Execute then s:=OpenDialog1.FileName;
    end
    полный путь храниться в переменной s
    Можете сделать так:
    PHP:
     procedure TForm1.Button1Click(SenderTObject);
    begin
     
    if OpenDialog1.Execute then Edit1.Text:=OpenDialog1.FileName;
    end
     
  10. diznt

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

    Joined:
    31 Jan 2008
    Messages:
    432
    Likes Received:
    164
    Reputations:
    -19
    НTL вроде так

    procedure TForm1.Button1Click(Sender: TObject);
    var
    s: string;
    begin
    if OpenDialog1.Execute then
    begin
    edit1.text:=OpenDialog1.FileName;
    end;
    end;

    Flame of Soul опередил :rolleyes: ;)
     
    1 person likes this.
  11. Vadimka

    Vadimka New Member

    Joined:
    30 Apr 2009
    Messages:
    1
    Likes Received:
    0
    Reputations:
    0
    Уважаемые дельфисты! Подправьте пож-та код....
    Жутко грузит систему

    Code:
    procedure TForm1.StartuemClick(Sender: TObject);
    var
    k: longint;
    H: HWND;
    
    begin
    StringGrid2.RowCount:=StringGrid2.RowCount+1;
    k:=StringGrid2.RowCount-3;
       for k := 0 to StringGrid1.RowCount - 1 do
      if k<>0 then
     begin
    
    ShellExecute(Handle,'open',pchar(StringGrid1.Cells [1,k]),nil,nil,SW_SHOWNORMAL);
     sleep(5000);
    
     H := FindWindow('IEFrame', nil);  
     SendMessage(H, WM_SYSCOMMAND, SC_CLOSE, 0);
     end;
    
    end;
     
  12. Flame of Soul

    Flame of Soul Elder - Старейшина

    Joined:
    25 May 2007
    Messages:
    185
    Likes Received:
    146
    Reputations:
    45
    sleep(5000); - это плохо, очень плёхо))) используйте таймер и счетчик тогда уж.))
    и также вставьте в тело цикла:
    PHP:
    if k<>0 then
     begin
    .....
    .....
      
    Application.ProcessMessages;
     
    end;
    Application.ProcessMessages; - дайте поработать системе.
     
    #3332 Flame of Soul, 3 May 2009
    Last edited: 3 May 2009
  13. НTL

    НTL Elder - Старейшина

    Joined:
    26 Jan 2008
    Messages:
    715
    Likes Received:
    205
    Reputations:
    -26
    Как можно вместо масаги отправить содержимое txt файла?
     
  14. Flame of Soul

    Flame of Soul Elder - Старейшина

    Joined:
    25 May 2007
    Messages:
    185
    Likes Received:
    146
    Reputations:
    45
    PHP:
    function GTFF(AFstring; var RSstring): Boolean;
    var
      
    FSTFileStream;
    begin
      Result 
    := False;
      if 
    not FileExists(AFthen Exit;
      
    FS:=TFileStream.Create(AFfmOpenRead);
      try if 
    FS.Size <> 0 then begin
      SetLength
    (RS,FS.Size);
      
    FS.Read(RS[1], FS.Size);
      
    Result := True;
      
    end; finally FS.Freeend;
    end;

    procedure TForm1.Button1Click(SenderTObject);
    var
       
    sstring;
    begin
       
    if GTFF('c:\ALCxxx-06.log'sthen
       ICQClient1
    .SendMessage(Ася,s);
    end;
     
  15. НTL

    НTL Elder - Старейшина

    Joined:
    26 Jan 2008
    Messages:
    715
    Likes Received:
    205
    Reputations:
    -26
    Как и куда это кидать?
     
  16. Zitt

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

    Joined:
    7 May 2006
    Messages:
    736
    Likes Received:
    268
    Reputations:
    59
    на мой вопрос никто не знает ответа? ))
     
  17. Flame of Soul

    Flame of Soul Elder - Старейшина

    Joined:
    25 May 2007
    Messages:
    185
    Likes Received:
    146
    Reputations:
    45
    а с какого компонента или какой файл какого формата выводится на печать? или просто текст и координаты?
    это функция поставь ее сразу после
    PHP:
    implementation

    {$R *.dfm}
     
  18. Zitt

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

    Joined:
    7 May 2006
    Messages:
    736
    Likes Received:
    268
    Reputations:
    59
    просто текст и координаты
     
  19. Flame of Soul

    Flame of Soul Elder - Старейшина

    Joined:
    25 May 2007
    Messages:
    185
    Likes Received:
    146
    Reputations:
    45

    самая тупая идея в 5 утра, нарисовать текст на картинке в нужных те координатах и распечатать картинку. Я с печатью никогда не работала, т.к. своего принтера нету.


    Рисуем Текст:

    PHP:
    var
      
    bm TBitmap;
      
    OldBkMode integer;
    begin
      bm 
    := TBitmap.Create;
      
    bm.Width := BitBtn1.Glyph.Width;
      
    bm.Height := BitBtn1.Glyph.Height;
      
    bm.Canvas.Draw(00BitBtn1.Glyph);
      
    OldBkMode := SetBkMode(bm.Canvas.HandleTransparent);
      
    bm.Canvas.TextOut(00'The Caption');
      
    SetBkMode(bm.Canvas.HandleOldBkMode);
      
    BitBtn1.Glyph.Assign(bm);
    end

    Печатаем картинку:

    PHP:
    procedure AngleTextOut(CVTCanvas; const sTextstringxyangleinteger);
    var
      
    LogFontTLogFont;
      
    SaveFontTFont;

      
    procedure TForm1.Button1Click(SenderTObject);
      var
        
    ScaleXScaleYInteger;
        
    RTRect;
      
    begin
        Printer
    .BeginDoc// **
        
    with Printer do
          try
            
    ScaleX := GetDeviceCaps(HandlelogPixelsXdiv PixelsPerInch;
            
    ScaleY := GetDeviceCaps(HandlelogPixelsYdiv PixelsPerInch;
            
    := Rect(00Image1.Picture.Width ScaleX,
              
    Image1.Picture.Height ScaleY);
            
    Canvas.StretchDraw(RImage1.Picture.Graphic); // **
          
    finally
            
    EndDoc// **
          
    end;
      
    end;
    //Данный код осуществляет корректное масштабирование
    //изображения, в противном случае при печати вы можете получить
    //небольшую иконку. Разрешение принтера больше, чем разрешение вашего
    //дисплея. 
     
    1 person likes this.
  20. Progeras

    Progeras New Member

    Joined:
    3 May 2009
    Messages:
    1
    Likes Received:
    0
    Reputations:
    0
    Вопрос по delphi.
    Суть заключается в том, чтобы программа
    1.Добавила новую секцию в exe файле.
    2.Записала туда какой-то код(он будет запрашивать пароль).
    3.Сменила точку входа(Entry point) на адрес добавленного кода.
    4.В конце добавленного кода поставила JMP на оригинальную точку входа(OEP).
    Теперь пояснение.
    Конечно сразу можно подумать, что я пишу вирус. Я знаю, что этим методом
    пользуются вирусы для заражения файлов. Но на самом деле я пишу защиту для своих програм.
    Дело в том, что есть у меня знакомый человек, который любит присваивать себе мои программы.
    Я не хочу использовать уже готовые программы, мне нужна своя.
    З.Ы. Не надо мне присылать смещения в PE Header'е и статьи на эту тему(про смещения).
    Я их прекрасно знаю, но не могу их примменять, поэтому жду от вас исходники,которые выполняют
    эти операции. Как добавлять новые секции я почти разобрался, а вот с EP я сел в яму.
    Гугл весь перерыл, но натыкался только на вирусы написанные на ASM'е, но они мне не нужны.
    З.Ы. З.Ы. За быстрый ответ с хорошим исходником, можете заработать вознаграждение
    на мобильник(50 или 100 руб.).
     
Thread Status:
Not open for further replies.