Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Вопросы по Delphi (все версии) - часть 4

Модерирует : ShIvADeSt

ShIvADeSt (28-06-2009 02:10): Продолжение в http://forum.ru-board.com/topic.cgi?forum=33&topic=10477  Версия для печати • ПодписатьсяДобавить в закладки
Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101

   

Maks150988



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Есть код вида:
 

Код:
program sample;
 
uses
 Windows, Messages, CommCtrl;
 
{$R dialog.res}
 
const
  RC_DIALOG  = 101;
  RC_ICON    = 101;
  ID_LISTBOX = 101;
 
var
  hApp : Integer;
  ListWnd : THandle;
  ListIco : hIcon;
  ListDC : hDC;
  RectLB : TRect;
  TextLB : array [0..$400] of Char;
 
function AppFuncProc(hWnd : HWND; uMsg : UINT; wParam, lParam : Integer) : BOOL; stdcall;
var
  I : Integer;
begin
  Result := TRUE;
 
  case uMsg of
 
    WM_MEASUREITEM :
      case wParam of
        ID_LISTBOX :
          begin
            with PMEASUREITEMSTRUCT(lParam)^ do
              begin
                itemHeight := 18;
              end;
          end;
      end;
 
    WM_DRAWITEM :
      case wParam of
        ID_LISTBOX :
          begin
            ListWnd := PDRAWITEMSTRUCT(lParam).hwndItem;
            RectLB := PDRAWITEMSTRUCT(lParam).rcItem;
            ListDC := PDRAWITEMSTRUCT(lParam).hDC;
            if (Integer(PDRAWITEMSTRUCT(lParam).ItemID) > - 1) then
              begin
                ListIco := LoadImage(hInstance, MAKEINTRESOURCE(RC_ICON), IMAGE_ICON, 16, 16, 0);
                if ((PDRAWITEMSTRUCT(lParam).itemState and ODS_SELECTED) <> 0) then
                  begin
                    FillRect(ListDC, RectLB, GetSysColorBrush(COLOR_HIGHLIGHT));
                    SetBkColor(ListDC, GetSysColor(COLOR_HIGHLIGHT));
                    SetTextColor(ListDC, GetSysColor(COLOR_HIGHLIGHTTEXT));
                  end
                else
                  begin
                    FillRect(ListDC, RectLB, GetSysColorBrush(COLOR_WINDOW));
                    SetBkColor(ListDC, GetSysColor(COLOR_WINDOW));
                    SetTextColor(ListDC, GetSysColor(COLOR_WINDOWTEXT));
                  end;
                DrawIconEx(ListDC, RectLB.Left + 2, RectLB.Top + 1, ListIco, 16, 16, 0, 0, DI_NORMAL);
                RectLB.Left := RectLB.Left + 22;
                SendMessage(ListWnd, LB_GETTEXT, PDRAWITEMSTRUCT(lParam).ItemID, LongInt(@TextLB[0]));
                DrawText(ListDC, @TextLB[0], - 1, RectLB, DT_SINGLELINE or DT_VCENTER);
                DeleteObject(ListIco);
              end;
            if ((PDRAWITEMSTRUCT(lParam).itemState and ODS_FOCUS) <> 0) then DrawFocusRect(ListDC, PDRAWITEMSTRUCT(lParam).rcItem);
          end;
      end;
 
    WM_INITDIALOG :
      begin
        hApp := hWnd;
        for I := 0 to 7 do SendMessage(GetDlgItem(hApp, ID_LISTBOX), LB_ADDSTRING, 0, Integer(PChar('ListBox String Ownerdraw !!!')));
      end;
 
    WM_DESTROY, WM_CLOSE : PostQuitMessage(0);
 
  else
    Result := FALSE;
  end;
end;
 
begin
  InitCommonControls;
  DialogBox(hInstance, MAKEINTRESOURCE(RC_DIALOG), 0, @AppFuncProc);
 
end.

 
Но текст в ListBox отображается крякозябрами. Что требуется исправить? Просто хочется перекрасить список, а тут напасть...

Всего записей: 836 | Зарегистр. 23-12-2006 | Отправлено: 13:14 12-06-2008
OdesitVadim



Advanced Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Maks150988
Сам шрифт не такой как надо? толстый и большой? (о том, что там не те буквы, я молчу)
Функция DrawText просто по умолчанию берёт шрифт где то с глубин и он не сопадает по кодировке. вот здесь http://msdn.microsoft.com/en-us/library/ms533909(VS.85).aspx описана эта функция. Когда то мучился с этим, кажется флаг DT_INTERNAL помог.

----------
Press any key to continue or any other key to exit
Пишите так, чтобы не было стыдно за нобелевскую премию.

Всего записей: 1568 | Зарегистр. 19-09-2003 | Отправлено: 13:44 12-06-2008
Maks150988



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Сам диалог такой:

Код:
101 DIALOG 0, 0, 210, 110
STYLE DS_CENTER | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU | WS_THICKFRAME
CAPTION ""
LANGUAGE LANG_RUSSIAN, 0x1
FONT 8, "Tahoma"
{
   CONTROL "", 101, LISTBOX, LBS_NOTIFY | LBS_OWNERDRAWFIXED | LBS_NOINTEGRALHEIGHT | WS_CHILD | WS_VISIBLE | WS_BORDER | WS_VSCROLL | WS_HSCROLL | WS_TABSTOP, 10, 5, 195, 92  
}

 
OdesitVadim
Шрифт я не изменяю. Попрбовал с DT_INTERNAL - не помогло. Может стили ListBox неправильные? Я засомневался насчет LBS_OWNERDRAWFIXED стиля...
И как понять что там не те буквы?

Всего записей: 836 | Зарегистр. 23-12-2006 | Отправлено: 14:20 12-06-2008 | Исправлено: Maks150988, 14:23 12-06-2008
OdesitVadim



Advanced Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору

Цитата:
И как понять что там не те буквы?

У меня были в виде груды букв ять (эта буква похожа на твердый знак).
LBS_OWNERDRAWFIXED - это нормально, это означает, что все элементы будут иметь одинаковую высоту.
 
Добавлено:
Собрал у себя пример. вместо строк отображает строку ":@"
 
Добавлено:
Думаю проблема в строке  
 SendMessage(ListWnd, LB_GETTEXT, PDRAWITEMSTRUCT(lParam).ItemID, LongInt(@TextLB[0]));
Эта строка не возвращает содержимое элемента. по крайней мере, отладчик так показал

----------
Press any key to continue or any other key to exit
Пишите так, чтобы не было стыдно за нобелевскую премию.

Всего записей: 1568 | Зарегистр. 19-09-2003 | Отправлено: 14:41 12-06-2008
Maks150988



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
OdesitVadim
Если таким макаром в ComboBox установить стиль CBS_OWNERDRAWVARIABLE, то такой метод прорисовки работает. Только там надо SendMessage(Handle, CB_GETLBTEXT, PDRAWITEMSTRUCT(lParam).ItemID, LongInt(@CbxPC[0])), С ListBox не получается. Хотелось бы найти решение этой проблемы. Раз отладчик показад что строка ничего не возращает, то я попробовал указать явно пукнт в списке, с которого надо получитьб текст. Тоже не получилось. Через TextOut вообще не получилось ничего вывести.
 
Добавлено:
Песец!!! Добавил к ЛистБоксу стиль LBS_HASSTRINGS и проблема исчезла...
=)

Всего записей: 836 | Зарегистр. 23-12-2006 | Отправлено: 16:02 12-06-2008 | Исправлено: Maks150988, 16:02 12-06-2008
Erazer



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

Код:
 
// примем то что пришло через Drag&Drop
  procedure TfmMain.AddFile(const FileName: string);
  var
    FileSize: TFileInfo;
    attrs: Integer;
  begin
    LboxSrcPath.Items.Add(FileName); // добавим-ка файл или каталог
      // создадим массив файлов
    FileList := TStringList.Create();
    FileList.Clear;
      //создадим массив размеров файлов
    FileSizeList := TStringList.Create();
    FileSizeList.Clear;
    attrs := FileGetAttr(FileName); // получить атрибуты
// если это каталог
   if attrs and faDirectory > 0 then
    begin
      mFileScan1.Filters.Clear;
      mFileScan1.Paths.Clear;
      mFileScan1.Paths.Add(FileName);
   //    если не все типы то тот который выбран
      if cbFileTypes.Itemindex <> 0 then
      begin
        mFileScan1.Filters.Add(cbFileTypes.Text);
      end
      else
      begin
 //    иначе все
        mFileScan1.Filters.Add('*.ac3');
        mFileScan1.Filters.Add('*.aac');
        mFileScan1.Filters.Add('*.wv');
      end;
 
      NoOfFiles := 0;
      mFileScan1.SubDirs := True;
//      ShowMessage(FileName);
      mFileScan1.Start;
  //ShowMessage(FileName+'  Finished');
    end else
    begin
     // а если файл...
      FileList.Add(FileName);
      // добавляем текущий файл в список
      FileSize := ReadFileInfo(FileName);
      // получаем размер файла в байтах.
      FileSizeList.Add(IntToStr(FileSize.Size)); // список размеров найденных файлов в байтах
     // размер текущего файла в байтах
    // добавляем размер текущего файла в список
      FillVTVWithFiles(FileList);
    end;
 
 FileList.Free;
 FileSizeList.Free;
  end;
 
  procedure TfmMain.mFileScan1Ready(Sender: TObject; Aborted: Boolean;
    SearchResult: TStringList);
  begin
//   ShowMessage('started');
    FillVTVWithFiles(SearchResult);
  VT.FullExpand; end;
 

эта процедура получает строку с именем файла или папки,и соответственно если файл то передает список процедуре строящей дерево по списку,или если папка запускает сканирование этой папки и как только сканирование окончено список найденных файлов процедуре строящей дерево по списку.
Суть проблемы: какого-то черта если перетащить и бросить несколько папок и файлов, то будет добавлена лишь 1 первая по алфавиту папка,и все файлы. если перетащить только папки,то картина повторится,добавлена будет только 1-я папка. если же в каком либо из мест приведенных здесь раскомментировать ShowMessage,то будут добавлены ВСЕ папки и все файлы. не могу взять в толк почему без ShowMessage нифига не работает, хотя AddFile всегда выполняется,это видно по тому что LboxSrcPath.Items.Add(FileName); всегда заполняется.

Всего записей: 1729 | Зарегистр. 02-08-2003 | Отправлено: 20:53 14-06-2008
Frodo_Torbins

Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Erazer
Может Application.ProcessMesages поставить вместо ShowMessage?

Всего записей: 2318 | Зарегистр. 24-05-2007 | Отправлено: 21:55 14-06-2008 | Исправлено: Frodo_Torbins, 21:55 14-06-2008
Maks150988



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Заметил одну ошибоку в прорисовке ЛистБокса. Если нажать на пункт в списке и начать елозить по списку курсором вверх-вниз при нажатой левой кнопке мыши, то через несколько секунд иконки у пунктов пропадают и остается только текст. С чем это может быть связано? В кривой прорисовке пунктов?

Всего записей: 836 | Зарегистр. 23-12-2006 | Отправлено: 11:49 15-06-2008
ShIvADeSt



Moderator
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Maks150988
есть более простой способ перекрасить ЛистБокс.

Цитата:
The WM_CTLCOLORLISTBOX message is sent to the parent window of a list box before Windows draws the list box. By responding to this message, the parent window can set the text and background colors of the list box by using the given display device context handle.  
 
WM_CTLCOLORLISTBOX  
hdcLB = (HDC) wParam;   // handle of list box display context  
hwndLB = (HWND) lParam; // handle of list box  
 
 
Parameters
 
hdcLB
 
Value of wParam. Identifies the device context for the list box.  
 
hwndLB
 
Value of lParam. Identifies the list box.  
 
 
 
Return Values
 
If an application processes this message, it must return the handle of a brush. Windows uses the brush to paint the background of the list box.  
 
Default Action
 
The DefWindowProc function selects the default system colors for the list box.  
 
Remarks
 
The WM_CTLCOLORLISTBOX message is never sent between threads. It is sent only within one thread.  
 

я так делал, если ничего больше не надо рисовать.
 


----------
И создал Бог женщину... Существо получилось злобное, но забавное...

Всего записей: 3956 | Зарегистр. 29-07-2003 | Отправлено: 06:45 16-06-2008
decu2007



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Доброго времени суток
Продскажите пожалуйста, где я могу скачать программу-Borland Delphi 2005 Architect Edition -извините, если пишу не туда можно ответ на ПМ или сюда

Всего записей: 1470 | Зарегистр. 23-05-2007 | Отправлено: 07:39 16-06-2008
quickas

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Огромная просьба, помогите решить:
Постановка задачи:
1. Номер минимального по модулю элемента массива.
2. Сумму модулей элементов массива, расположенных после первого отрица-тельного элемента.
Сжать массив, удалив из него все элементы, величина которых находится в интервале [a,b]. Освободившиеся в конце массива элементы заполнить нулями.

Всего записей: 1 | Зарегистр. 16-06-2008 | Отправлено: 08:14 16-06-2008
Frodo_Torbins

Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
decu2007
2005 очень глючная, берите 2007: http://forum.ru-board.com/topic.cgi?forum=35&bm=1&topic=38537#1 разницы не заметите.

Всего записей: 2318 | Зарегистр. 24-05-2007 | Отправлено: 10:55 16-06-2008
Antananarivu

Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Dimoniusis
А не можете выложить рабочую версию программы, которая соединяется с почтовым ящиком, скачивает и сохраняет в папочку все аттачи и текст письма... а то я что-то торможу. Еще лучше если кинете ссылочку на работающий проект или вышлете ее на почту "antananarivu83@mail.ru". Заранее огромное спасибо!

Всего записей: 151 | Зарегистр. 10-10-2006 | Отправлено: 15:01 16-06-2008
Mixanitch



Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Люди, помогите с задачкой. есть шаблон матрицы . нужно в stringgrid зафиксировать ненужные ячейки , чтобы в них нельзя было ввести и вид у них был как у фиксированных столбцов. или , например, зафиксировать несколько столбцов, а при нажатии на определённую ячейку фиксация снималась бы не со всего столбца, а только с этой ячейки.

Всего записей: 47 | Зарегистр. 13-02-2006 | Отправлено: 23:48 16-06-2008
EX_unfreqient

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Коллеги! Дайте совет: нужно инсталлировать шрифты для приложения, делается это программно так
  AddFontResource(PChar(FontFullFileName));
  SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
Перерыл весь интернет, везде одни и те же решения. За исключением того, что советуется копировать шрифты в папку Windows\Fonts\ или прописывать в реестре. Всё работает, НО, шрифты ПРОПАДАЮТ! Замечен такой "глюк" при котором можно "потерять" шрифты: загружаем ПК, открываем файл в Word, в котором используются эти шрифты до запуска приложения с инсталляцией - шрифты не отображаются, потому, что их нет. Всё логично. Закрываем Word. Потом запускаем приложение с инсталляцией шрифтов и видим, что шрифты не установились.  
  Может нужно как-то по другому инсталировать шрифты в систему, более надёжно. Или снять блокировки со шрифтов. Инсталлировать "навсегда" шрифты в систему не предлагайте.

Всего записей: 3 | Зарегистр. 07-02-2008 | Отправлено: 10:47 17-06-2008 | Исправлено: EX_unfreqient, 11:04 17-06-2008
OdesitVadim



Advanced Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Надёжно - это "навсегда". не надо будут - удаляйте. А ещё ворд умеет хранить шрифты внутри документа. может это, что надо?

----------
Press any key to continue or any other key to exit
Пишите так, чтобы не было стыдно за нобелевскую премию.

Всего записей: 1568 | Зарегистр. 19-09-2003 | Отправлено: 11:23 17-06-2008
AndreyAgrh



Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Может быть возможно встроить шрифт в документ?

Всего записей: 204 | Зарегистр. 30-06-2007 | Отправлено: 11:27 17-06-2008
EX_unfreqient

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Цель - пользоваться шрифтами только из своего проложения. При запуске приложения, шрифты инсталируются, при закрытии удаляются. Но, при подобных методах установки, пользователи могут пользоваться этими шрифтами (нельзя запретить), а это приводит к "падению" шрифтов в системе. То есть, если шрифт, подобным образом "падает", то и файл шрифта при открытии становится "не таким" - при просмотре в Windows он как "пустой". Причём, вот шрифт есть, а потом вдруг падает. Происходило на многих ПК под XP.

Всего записей: 3 | Зарегистр. 07-02-2008 | Отправлено: 11:47 17-06-2008
Dimoniusis



Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

Цитата:
А где взять сие чудо?
На сайте и взять. Оно бесплатное, Open Source и тд итп. И примеров куча на сайте же...
 
Antananarivu http://www.overbyte.be/eng/products/usermade.html - искать по "mail" на странице... примеров вполне достаточно
 
 

Всего записей: 4134 | Зарегистр. 18-10-2005 | Отправлено: 13:11 17-06-2008
OdesitVadim



Advanced Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
EX_unfreqient
Я конечно не понимаю, зачем понадобилось такое, но тогда просто надо не инсталировать шрифты и всё. Просто положить их рядом в папке с программой. И можно будет использовать  в приложении просто указав имя.

----------
Press any key to continue or any other key to exit
Пишите так, чтобы не было стыдно за нобелевскую премию.

Всего записей: 1568 | Зарегистр. 19-09-2003 | Отправлено: 14:39 17-06-2008
   

Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Вопросы по Delphi (все версии) - часть 4
ShIvADeSt (28-06-2009 02:10): Продолжение в http://forum.ru-board.com/topic.cgi?forum=33&topic=10477


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru