Ru-Board.club
← Вернуться в раздел «Прикладное программирование»

» Вопросы по Delphi (до версии 2009) - часть 6

Автор: ESV1987
Дата сообщения: 18.07.2012 15:33
XCV81
а чего нельзя получить список всех .тхт-файлов в директории в массив, а потом убрать из него те, которые совпадают с 1.тхт и 10.тхт. А затем по именам из массива копировать?
Автор: XCV81
Дата сообщения: 18.07.2012 16:33
ESV1987, в принципе вариант, как-то даже не думалось в эту сторону, вообще искал готовый модуль с функцией копирования всех файлов по маске с заданием исключений, спасибо за идею
Автор: ESV1987
Дата сообщения: 18.07.2012 18:10
у меня тоже вопросик: TrackBar поставил впервые на форму своей программы, всё вроде настроил, а потом выяснилось, что он по умолчанию реагирует на вращение колёсика мыши

как это убрать или по крайней мере, чтоб это осталось только когда трэкбар выделен, а не в пассивном состоянии?

(суть в том, что на первой панели ни на что больше фокус нельзя поставить, наверное)
Автор: Maks150988
Дата сообщения: 22.07.2012 10:48
Проблема в следующем. Почему aiex.pszError такой же как и aiex.pszUpdated? На Неюникод аналоге все нормально. Может что-то связано с FormatW? Или присваиваю строки неправильно?

[more=Код]

program Project;

uses
Windows, Messages;

type
ACCOUNT_INFO = record
dwErrorCode : DWORD;
pszTarifName : LPWSTR;
cchTarifNameMax: DWORD;
pszMsgError : LPWSTR;
cchMsgErrorMax : DWORD;
end;
ACCOUNT_INFO_EX = record
dwErrorCode : DWORD;
pszTarif : LPWSTR;
cchTarifMax : DWORD;
pszUpdated : LPWSTR;
cchUpdatedMax: DWORD;
pszError : LPWSTR;
cchErrorMax : DWORD;
end;

function FormatW(const pszText: WideString; const Params: Array of const): WideString;
var
lpChar: Array [0..2048] of WideChar;
lpWord: Array [0..15] of LongWord;
I : Integer;
begin
for I := High(Params) downto 0 do
lpWord[I] := Params[I].VInteger;
wvsprintfW(@lpChar, LPWSTR(pszText), @lpWord);
Result := lpChar;
end;

function FormatUpdateTimeDateW(const st: TSystemTime): WideString;
const
pszTime: WideString = '%.2d:%.2d:%.2d %.2d-%.2d-%.4d';
begin
Result := FormatW(pszTime, [st.wHour, st.wMinute, st.wSecond, st.wDay,
st.wMonth, st.wYear]);
end;

procedure PluginExecute(var ai: ACCOUNT_INFO);
type
TBillingInfo = record
errorCode: Integer;
tarifName: WideString;
msgError : WideString;
end;
const
pszTarif: WideString = 'Тариф';
pszError: WideString = 'Ошибок не обнаружено';
var
binfo: TBillingInfo;
begin
ZeroMemory(@binfo, SizeOf(TBillingInfo));
binfo.errorCode := NO_ERROR;
binfo.tarifName := pszTarif;
binfo.msgError := pszError;
ai.dwErrorCode := binfo.errorCode;
ai.pszTarifName := LPWSTR(binfo.tarifName);
ai.cchTarifNameMax := (lstrlenW(ai.pszTarifName) + 1) * SizeOf(WideChar);
ai.pszMsgError := LPWSTR(binfo.msgError);
ai.cchMsgErrorMax := (lstrlenW(ai.pszMsgError) + 1) * SizeOf(WideChar);
end;

var
ai : ACCOUNT_INFO;
aiex : ACCOUNT_INFO_EX;
st : TSystemTime;
pszText: WideString;
begin

ZeroMemory(@ai, SizeOf(ACCOUNT_INFO));
ZeroMemory(@aiex, SizeOf(ACCOUNT_INFO_EX));

PluginExecute(ai);

GetLocalTime(st);
pszText := FormatUpdateTimeDateW(st);

aiex.dwErrorCode := ai.dwErrorCode;
aiex.pszTarif := ai.pszTarifName;
aiex.cchTarifMax := ai.cchTarifNameMax;
aiex.pszUpdated := LPWSTR(pszText);
aiex.cchUpdatedMax := (lstrlenW(aiex.pszUpdated) + 1) * SizeOf(WideChar);
aiex.pszError := ai.pszMsgError;
aiex.cchErrorMax := ai.cchMsgErrorMax;

MessageBoxW( GetActiveWindow, aiex.pszTarif, nil, MB_OK );
MessageBoxW( GetActiveWindow, aiex.pszUpdated, nil, MB_OK );
MessageBoxW( GetActiveWindow, aiex.pszError, nil, MB_OK );

end.

[/more]
Автор: jFobos
Дата сообщения: 22.07.2012 21:28
ESV1987,
Могу предложить создать "обертку"

Цитата:
THackTTrackBar = class(TTrackBar)
private
procedure TBMouseWheel(var Message: THBMouseWheel); message CM_MOUSEWHEEL;
end;

implementation

procedure THackTTrackBar.TBMouseWheel(var Message: THBMouseWheel);
begin
// Убиваем прокрутку колеса мыши
// никакой реакции на сообщение от колеса нету
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
PPointer(TrackBar1)^ := THackTTrackBar;
end;
Автор: Frodo_Torbins
Дата сообщения: 22.07.2012 22:16
ESV1987
Просто форме ActiveControl другой выставить да и все.

jFobos
Если контрол такой только один, то можно еще так: http://www.delphikingdom.ru/asp/viewitem.asp?catalogid=1367
Автор: Eternal_Shield
Дата сообщения: 23.07.2012 12:36
Maks150988
Не забывайте, что приведение WideString к PWideChar/LPWSTR не продлевает жизнь строке.

Обратите внимание на процедуру PluginExecute. Вы заполняете структуру binfo и ассоциируете ai с её полями ... но, ведь, после выхода из процедуры структура binfo уничтожается и, в итоге, LPWSTR поля в ai указывают неизвестно куда. Поэтому вы и получаете мусор. Надеюсь вы дальше сообразите что делать
Автор: Aleksandr N
Дата сообщения: 23.07.2012 16:26
Возник вопрос.
Рисую на 32 битном TBitmap. Потом мне нужно его очистить так чтобы он стал прозрачным. InValidateRect даёт заливку белым. Нужно чтобы TBitmap действительно стал прозрачным, а не указать свойство Transparent.
Как это сделать?
Автор: SevereK20
Дата сообщения: 23.07.2012 16:53
Aleksandr N
отпишитесь, если найдете решение проблемы.
я использовал фон формы..
Автор: Aleksandr N
Дата сообщения: 23.07.2012 16:57
SevereK20
Мне этот способ не подходит. Мне нужно именно прозрачное.
Автор: jFobos
Дата сообщения: 23.07.2012 19:51
Aleksandr N
У TBitmap нету альфа канала. Переходите на TPNGImage (или gif/ico).
Автор: Frodo_Torbins
Дата сообщения: 23.07.2012 20:38
Aleksandr N
В цикле через ScanLine интерпретируйте каждый пиксель как Cardinal и присваивайте ноль. Можно еще ZeroMemory попробовать, но там не совсем тривиальная математика требуется.
Автор: Aleksandr N
Дата сообщения: 23.07.2012 22:18
jFobos
По крайней мере точно можно сделать реальную картинку с прозрачностью, а как при этом называется альфа канал дело десятое.
Frodo_Torbins
Вот и хотелось-бы какой-то пример реализации...
Автор: krapotkin
Дата сообщения: 24.07.2012 07:56
Aleksandr N
Прозрачность битмапа при выводе - это скорее особенность реализации конкретной библиотеки
Например, при выводе на TImageBtn брался за прозрачный цвет левой нижней точки...

Поэтому неплохо бы знать - где рисовать то?
Автор: Maks150988
Дата сообщения: 24.07.2012 08:53
Eternal_Shield

Хм, да вот честно, не знаю или знаю, но не соображу... Даже ели оставить структуру TBillingInfo такой с вайдстрингами, то что можно сделать? Копировать вайдстринги в функции PluginExecute через lstrcpynW?

Сделал тогда так:


Цитата:

function PluginExecute(out ai: ACCOUNT_INFO): BOOL; stdcall;
type
TBillingInfo = record
errorCode : Integer;
msgError : LPWSTR;
balanceMoney: Double;
balanceDraft: Double;
tarifName : LPWSTR;
tarifDays : Integer;
daysLeft : Integer;
end;
const
pszTarif: LPWSTR = 'Тариф';
pszError: LPWSTR = 'Ошибок не обнаружено';
var
binfo: TBillingInfo;
begin
ZeroMemory(@binfo, SizeOf(TBillingInfo));
binfo.errorCode := NO_ERROR;
binfo.msgError := pszError;
binfo.balanceMoney:= 250.00;
binfo.balanceDraft:= 30.00;
binfo.tarifName := pszTarif;
binfo.tarifDays := -1;
binfo.daysLeft := -1
ai.fBalance := binfo.balanceMoney;
ai.fOverdraft := binfo.balanceDraft;
ai.pszTarif := binfo.tarifName;
ai.cchTarifMax := (lstrlenW(ai.pszTarif) + 1) * SizeOf(WideChar);
ai.dwTarifDays := binfo.tarifDays;
ai.dwTarifDaysLeft := binfo.daysLeft;
ai.dwErrorCode := binfo.errorCode;
ai.pszError := binfo.msgError;
ai.cchErrorMax := (lstrlenW(ai.pszError) + 1) * SizeOf(WideChar);
Result := TRUE;
end;


Ну вроде бы оно работает. Только все равно наобум получилось. Не знаю как корректнее...
Автор: Eternal_Shield
Дата сообщения: 24.07.2012 11:04
Maks150988
Как вариант, все необходимые константы сделать глобальными. Тогда на них можно без проблем ссылаться ... не знаю чего вы там кодите, поэтому больше посоветовать ничего не могу.
Автор: Aleksandr N
Дата сообщения: 24.07.2012 11:30
krapotkin
Где рисовать не столь важно:
FBmp := TBitmap.Create;
FBmp.HandleType := bmDIB;
FBmp.PixelFormat := pf32bit;
рисуешь
вот и весь метод реализации.
А "брался за прозрачный цвет левой нижней точки" это как раз свойство Transparent. При этом изображение нисколько не прозрачное, просто удаляется именно этот цвет.
Вот этот TBitmap мне и надо очистить чтобы не было никакой заливки цветом.

Метод очистки не имеет значения: VCL или API.
Автор: Frodo_Torbins
Дата сообщения: 24.07.2012 12:06
krapotkin
Познакомьтесь с функцией AlphaBlend. Кстати в последних версиях делфей она активно используется в RTL.

Aleksandr N
Если битмап тридцатидвухбитный, то нужно лишь знать, что строки в памяти располагаются начиная с нижней:
Код: b.PixelFormat := pf32bit;
ZeroMemory(b.ScanLine[b.Height -1], 4 * b.Height * b.Width);
Автор: Maks150988
Дата сообщения: 24.07.2012 13:53
Eternal_Shield
Функция PluginExecute находится вобще в сторонней DLL, она вызывается моей программой - плагин короче это. Плагин должен правильно заполнить структуру ACCOUNT_INFO, а моя программа использует эти данные вдальнейшем. Для удобства (а есть ли оно теперь уже) я завел отдельную структуру TBillingInfo, в которой оперирую данными, меняющимися несколько раз. После всех действий "скидываю" из TBillingInfo данные в ACCOUNT_INFO. Просто здесь урезанный код привел.
Автор: Eternal_Shield
Дата сообщения: 24.07.2012 16:28
Maks150988
Ну то, что это плагин - я догадался. Просто было неизвестно, если ли доступ к самой программе (может вы просто плагин к чьей-то проге пишите). Раз обе части программы доступны полностью, то можно в плагине везде использовать WideString, а в приложении (я так понимаю, оно на С++ написано) использовать BSTR; В теории должно работать. Если комплекс вообще на делфи, то просто WideString;
Автор: Maks150988
Дата сообщения: 24.07.2012 16:37
Eternal_Shield
Программа и плагины написаны на Delphi мной. Сделал SDK под это дело с описанием структур и функций плагинов для остальных программистов, кто захочет написать свой плагин под своего оператора. Насчет WideString и BSTR немного не понял... Мне как результат возвращать их или тоже в структурах?
Автор: Aleksandr N
Дата сообщения: 24.07.2012 16:40
Frodo_Torbins
Спасибо, попробую. Логически рассуждая должно сработать.
Автор: Aleksandr N
Дата сообщения: 24.07.2012 20:53
Frodo_Torbins
Сработало, ещё раз спасибо.
Автор: Eternal_Shield
Дата сообщения: 26.07.2012 15:51
Maks150988

Цитата:
Насчет WideString и BSTR немного не понял... Мне как результат возвращать их или тоже в структурах?

Да, везде использовать WideString, а вот если плагин будет писаться на Си, то вместо типа WideString в структурах плагина использовать тип BSTR. Честно, сам никогда не пробовал - не знаю, но ем-ро говорит, что BSTR - это эквивалент WideString .. поэтому всё должно работать.
Автор: XCV81
Дата сообщения: 07.08.2012 15:22
написал небольшую прогу без vcl использую winapi, при запуске открывается окошко в нем 2 объекта: RichEdit и кнопка, в RichEdit выводится некоторая информация, а кнопка просто ее обновляет, все хорошо, но... окошко получается определенного размера в котором и размещены эти объекты, но при попытке изменить размер окна программы - размер формы меняется, а вот размер объектов и их положение остаются неизменными... как сделать чтобы при изменении размера окна программы менялись и размер/положение остальных объектов?
Главную форму и объекты на ней создаю так:
[more]
// Заполняем структуру TWndClassEx
with Wc do
begin
style := CS_HREDRAW or CS_VREDRAW;
cbSize := Sizeof( Wc );
lpfnWndProc := @WindowProc; //указатель на оконную процедуру
cbClsExtra := 0; //Выделенная память, используемая программой по своему усмотрению.
cbWndExtra := 0; //Выделенная память, используемая программой по своему усмотрению.
hInstance := hInstance; //описатель экземпляра приложения
hbrBackground := COLOR_BTNFACE+1; //цвет фона формы.
lpszClassName := WndClass; //имя класса создаваемого объекта
end;
// Регистрируем класс в системе
RegisterClassEx( Wc );
//Создаём окно
Wnd := CreateWindowEx ( 1, WndClass, WndCaption, WS_SYSMENU or WS_MINIMIZEBOX or WS_SIZEBOX or WS_MAXIMIZEBOX, (GetSystemMetrics(0) - (GetSystemMetrics(0) Div 2)) div 2, (GetSystemMetrics(1) - (GetSystemMetrics(1) Div 2)) div 2, GetSystemMetrics(0) Div 2, GetSystemMetrics(1) Div 2, 0, 0, hInstance, nil);
SendMessage(Wnd, WM_SETICON, 1, LoadIcon(HInstance, 'MAINICON')); //иконка приложения
// Показываем окно программы
ShowWindow( Wnd, SW_SHOWNORMAL );
// Создаём элементы окна
GetWindowREct(Wnd,R);
Buttons := CreateWindowEx( WS_EX_STATICEDGE, 'Button', PAnsiChar('Обновить'), BS_DEFPUSHBUTTON or WS_VISIBLE or WS_CHILD, 10, R.Bottom-R.Top-60, R.Right-R.Left-30, 25, Wnd, 101, hInstance, nil );
hRichDll := LoadLibrary('Riched20.dll');
RichEdit1 := CreateWindowEx (WS_EX_STATICEDGE,'RichEdit20W','',WS_VISIBLE or WS_VSCROLL or WS_HSCROLL or WS_CHILD or ES_AUTOVSCROLL or ES_WANTRETURN or ES_MULTILINE, 10, 10, R.Right-R.Left-30, R.Bottom-R.Top-80,Wnd,0,Hinstance,nil);
[/more]
для перерисовки объектов после изменения размера главной формы добавил в обработчик сообщений:
[more]
WM_SIZE:
begin
GetWindowREct(Wnd,R);
InvalidateRect(Wnd, nil, TRUE);
InvalidateRect(RichEdit1, nil, TRUE);
InvalidateRect(Buttons, nil, TRUE);
UpdateWindow(Wnd) ;
UpdateWindow(Buttons) ;
UpdateWindow(RichEdit1) ;
end;
[/more]
по идее все объекты должны перерисоваться причем дважды, однако ни размер, ни их положение не меняется. Попробовал туда же добавить команду удаления кнопки и заново ее создать:
[more]
WM_SIZE:
begin
GetWindowREct(Wnd,R);
InvalidateRect(Wnd, nil, TRUE);
InvalidateRect(RichEdit1, nil, TRUE);
UpdateWindow(Wnd) ;
UpdateWindow(RichEdit1) ;
DestroyWindow(Buttons);
Buttons := CreateWindowEx( WS_EX_STATICEDGE, 'Button', PAnsiChar('Обновить'), BS_DEFPUSHBUTTON or WS_VISIBLE or WS_CHILD, 10, R.Bottom-R.Top-60, R.Right-R.Left-30, 25, Wnd, 101, hInstance, nil );
end;
[/more]
получилось вообще забавно, после изменения размеров кнопки создается новая кнопка с "правильными" размером и положением, но дополнительно появляется и кнопка которая была изначально, тоесть получается 2 кнопки с одной и той же функцией, но разных размеров и в разных местах (откуда вообще берется 2-я кнопка), к слову если из последнего кода выбросить команду по созданию кнопки - то после изменения размеров окна кнопка просто пропадает (в принципе так и должно быть) - следовательно 1 команда Buttons := CreateWindowEx( WS_EX_STATICEDGE, 'Button', PAnsiChar('Обновить'), BS_DEFPUSHBUTTON or WS_VISIBLE or WS_CHILD, 10, R.Bottom-R.Top-60, R.Right-R.Left-30, 25, Wnd, 101, hInstance, nil ); создает 2 каким-то образом кнопки - "правильную" и "не правильную"...
Подскажите пожалуйста как правильно заставить изменяться объекты при изменении формы.
Заранее благодарен.
Автор: V1s1ter
Дата сообщения: 07.08.2012 16:19
XCV81
Вам нужно вызвать SetWindowPos

Код:
WM_SIZE:
begin
....
SetWindowPos ....
....
end
Автор: XCV81
Дата сообщения: 07.08.2012 17:58
V1s1ter, спасибо огромное, действительно то что надо, век живи век учись
Автор: Ichigo2
Дата сообщения: 12.08.2012 21:09
Привет всем.
Нужна ваша помощь, я уже весь измучился.
В одном месте никак не хочет работать функция pos. Вот кусок кода

Код:
for i := 0 to length(rec) do
begin
if pos(_tag,rec[i].tag)<>0 then
with form1.StringGrid1 do
begin
...
Автор: idiMAN
Дата сообщения: 13.08.2012 11:08
Ichigo2
Если rec - массив, то правильние будет писать

Код:
for i := Low(rec) to High(rec) do
Автор: Ichigo2
Дата сообщения: 13.08.2012 20:08
Вот скрин переменных на строчке pos

Переменные string, объявлены глобально. Делал через локальные - тоже не помогает.

Страницы: 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374

Предыдущая тема: MPO File


Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.