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

ShIvADeSt
Спасибо, помогло! А как две строки там припаять друг к другу в рамках одного винекзека?

ShIvADeSt

Сделал так:


Код:
WinDC : hDC;
PaintStr : TPaintStruct;
hdcMem : hDC;
hbmMem : hBitmap;
OldMem : hBitmap;


WM_ERASEBKGND :
begin
Result := FALSE;
end;
WM_PAINT :
begin
WinDC := BeginPaint(hWndPls, PaintStr);
GetClientRect(hWndPls, Rect);
hdcMem := CreateCompatibleDC(WinDC);
hbmMem := CreateCompatibleBitmap(WinDC, Rect.Right, Rect.bottom);
OldMem := SelectObject(hdcMem, hbmMem);
BitBlt(hdcMem, 0, 0, Rect.Right, Rect.Bottom, WinDC, 0, 0, SRCCOPY);
BitBlt(WinDC, 0, 0, Rect.Right, Rect.Bottom, hdcMem, 0, 0, SRCCOPY);
SelectObject(hdcMem, OldMem);
DeleteObject(hbmMem);
DeleteObject(hdcMem);
EndPaint(hWndPls, PaintStr);
end;

Создал тему Доступ к объектам MS Word из Delphi и задал там вопрос (и еще задам ). Посмотрите, пожалуйста.

Maks150988
Как обычно выложи куда нить сорс в виде простой программы. Я посмотрю.

ShIvADeSt
http://webdrive.avtograd.ru/Download/Explorer/Download/listbox_test_draw.rar
Решил сюда тогда код добавить. Все равно изменение размеров окна в коде есть.

Maks150988
Кажется понял, когда ты ресайзишь окно, то у тебя мелькают все элементы? Если да - то это нормальное поведение, возьми любую программу и поресайзь ее, увидишь тоже самое мелькание. Я думал у тебя мелькание, когда ты рисуешь на самой форме. А с этим мерцанием даже не парься - нормальное поведение, как вариант - запрети отображать содержимое окна при перетаскивании - тогда и при ресайзе не будет видно видно мерцания, пока ресайз не закончат.

ShIvADeSt
Да ну какое-то сильное мерцание. А как правильнее то запретить содержимсое при перетаскивании? Как-то пробовал обрабатывать сообщения начала и окончания перемещения, только фиг знает что в код написать нужно. Писал WM_SETREDRAW и LockWindowUpdate, но конечно это огород какой-то и тем более после завершения действия по изменению размеров окно не появлялось, а система начинала жутко тормозить. Хотелось бы как в Винампе тогда чтоб при перемещении рисовалась рамочка на месте границ окна поди через какой-нибудь DrawFocusRect или как там у них это делается.

Maks150988
Вот хак, примерно как у Винампа

Код:
WM_EXITSIZEMOVE:
SystemParametersInfo( SPI_SETDRAGFULLWINDOWS, Ord(True), Nil, SPIF_SENDWININICHANGE);

WM_GETMINMAXINFO :
begin
MinMax := PMinMaxInfo(lParam);
MinMax.ptMinTrackSize.X := 286;
MinMax.ptMinTrackSize.Y := 213;
SystemParametersInfo( SPI_SETDRAGFULLWINDOWS, Ord(False), Nil, SPIF_SENDWININICHANGE);
end;

Такой вопрос на засыпку - где можно скачать делфи 2009?

LeitoF2
Тут: Embarcadero (CodeGear) RAD Studio 2009

ShIvADeSt
Да мне вполне хватит такой прорисовки окна. =)



Еще такой вопрос к знатокам Делфи. Есть необходимость нарисовать кнопку сворачивания окна в заголовке со стилем Toolwindow. Кнопка то проирисовывается, но хочется чтоб уж прорисовывалась нормально с разными темами и на разных системах.

http://webdrive.avtograd.ru/Download/Explorer/Download/min_button_toolwnd.rar

Непонятки с синхронизацией проверочных переменных для WM_NCHITTEST. В этом сообщении надо обработать наведение указателя в кнопку, но тот код, который мне удалось сделать, косячный - кнопка автоматически меняет свое нажатие через секунуду попеременно. Собственно код взял с http://www.delphikingdom.com/asp/answer.asp?IDAnswer=61614 , но там хук на окно, а хочется без этой лабуды и без сабклассинга окна через это сообщение. И еще интересует появление обычной системной всплывающей подсказки для этой кнопки. Также в XP если используется классическая тема оформления, кнопка умеьшается в размерах в 2 раза и выглядит как точка. Что можно предпринять? Спасибо.

Необходимо скопировать лист "DVD" из книги movies.xls в книгу repoert.xls, подскажите как:


Код: Excel.Workbooks('d:\movies.xls').sheets.item['DVD'].copy(Before:=Excel.Workbooks('d:\report.xls').Sheets.item[1]);

Maks150988
Написано, что хук на окно можно не ставить, один фиг не работает. Вверху есть упоминание джедайских контролов, там можно взять сорсы кнопки для заголовка. Я в свое время делал так же, проверял нажатие на попадание в RECT кнопки и отрисовывал то, что надо.

Добавлено:
Maks150988
[more]

Код:
program sample;

uses
Windows, Messages, Classes, UxTheme, TmSchema;

{$R dialog.res}

var
BtnRect : TRect; // Êîîðäèíàòû êíîïêè ñâåðòûâàíèÿ îêíà
WndRect : TRect; // Êîîðäèíàòû îêíà ïðèëîæåíèÿ
ShlTheme : hTheme; // Óêàçàòåëü íà èñïîëüçóåìóþ òåìó îáîëî÷êè
hWndApp : THandle; // Óêàçàòåëü íà ãëàâíîå îêíî ïðèëîæåíèÿ
Pressed, Focused : Boolean; // Ñîñòîÿíèå íàæàòèÿ êíîïêè ñâåðòûâàíèÿ
Actived : Boolean; // Ñîñòîÿíèå àêòèâíîñòè êíîïêè èç-çà îêíà
CursorPt : TPoint; // Êîîðäèíàòû óêàçàòåëÿ äëÿ êíîïêè

procedure PaintMinimizeToolButton(hWnd : THandle);
var
WinDC : HDC;
SizeX : Integer;
SizeY : Integer;
Xframe : Integer;
Yframe : Integer;
begin
GetWindowRect(hWnd, WndRect);
WinDC := GetWindowDc(hWnd);
SizeX := GetSystemMetrics(SM_CXSIZE);
SizeY := GetSystemMetrics(SM_CYSIZE);
xFrame := GetSystemMetrics(SM_CXFRAME);
yFrame := GetSystemMetrics(SM_CYFRAME);
BtnRect := Bounds(WndRect.Right - WndRect.Left - xFrame - SizeX - 6, yFrame + 2, SizeX - 12, SizeY - 12);
if (Pressed and Focused) then
begin
if InitThemeLibrary and UseThemes then
DrawThemeBackground(ShlTheme, WinDC, WP_MINBUTTON, MINBS_PUSHED, BtnRect, nil)
else
DrawFrameControl(WinDC, BtnRect, DFC_CAPTION, DFCS_CAPTIONMIN or DFCS_PUSHED);
end
else
begin
if InitThemeLibrary and UseThemes then
DrawThemeBackground(ShlTheme, WinDC, WP_MINBUTTON, MINBS_NORMAL, BtnRect, nil)
else
DrawFrameControl(WinDC, BtnRect, DFC_CAPTION, DFCS_CAPTIONMIN);
end;
if NOT Actived then
begin
if InitThemeLibrary and UseThemes then
DrawThemeBackground(ShlTheme, WinDC, WP_MINBUTTON, 5, BtnRect, nil)
else
DrawFrameControl(WinDC, BtnRect, DFC_CAPTION, DFCS_CAPTIONMIN);
end;
ReleaseDC(hWnd, WinDC);
end;

function DlgProc(hWin: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): bool; stdcall;
begin
Result := False;
case uMsg of

// Èíèöèàëèçàöèÿ äèàëîãîâîãî îêíà ïðèëîæåíèÿ

WM_INITDIALOG :
begin
hWndApp := hWin;
if InitThemeLibrary and UseThemes then
ShlTheme := OpenThemeData(hWndApp, 'Window');
end;

// Ðåàãèðîâàíèå íà èçìåíåíèå öâåòîâîé òåìû Windows

WM_THEMECHANGED :
begin
if InitThemeLibrary and UseThemes then
begin
CloseThemeData(ShlTheme);
ShlTheme := OpenThemeData(hWndApp, 'Window');
end;
end;

// Ïðîðèñîâêà êíîêè ñâåðòûâàíèÿ ïðè àêòèâíîñòè îêíà

WM_PAINT, WM_NCPAINT, WM_NCACTIVATE :
begin
// Actived := TRUE;
PaintMinimizeToolButton(hWndApp);
end;

// Ïðîðèñîâêà êíîêè ñâåðòûâàíèÿ ïðè íåàêòèâíîñòè îêíà

WM_ACTIVATE :
begin
if LOWORD(wP)=WA_INACTIVE then
Actived := False
else
Actived := True;
PaintMinimizeToolButton(hWndApp);
end;

// Îáðàáîòêà ñîîáùåíèÿ íàæàòèÿ ëåâîé êíîïêîé óêàçàòåëÿ

WM_NCLBUTTONDOWN :
begin
GetCursorPos(CursorPt);
GetWindowRect(hWndApp, WndRect);
CursorPt := Point(CursorPt.X - WndRect.Left, CursorPt.Y - WndRect.Top);
if PtInRect(BtnRect, CursorPt) then begin
Pressed:=True;
Focused:=True;
PaintMinimizeToolButton(hWndApp);
Result:=True;
end;
end;
WM_LBUTTONUP: begin
Pressed:=False;
Focused:=False;
end;

WM_NCMOUSEMOVE :begin
if HiWord(GetAsyncKeyState(VK_LBUTTON))=0 then begin
Focused:=False;
Pressed:=False;
end;
GetCursorPos(CursorPt);
GetWindowRect(hWndApp, WndRect);
if Focused then begin
Focused:=False;
PaintMinimizeToolButton(hWndApp);
end;
CursorPt := Point(CursorPt.X - WndRect.Left, CursorPt.Y - WndRect.Top);
if PtInRect(BtnRect, CursorPt) then begin
// Pressed:=True;
Focused:=True;
PaintMinimizeToolButton(hWndApp);
end;
end;
WM_NCLBUTTONUP :
begin
if Pressed then begin
Pressed:=False;
PaintMinimizeToolButton(hWndApp);
end;
end;


// Íàæàòèå ïðàâîé êíîïêîé óêàçàòåëÿ íà çàãîëîâîê

WM_NCRBUTTONDOWN:
begin
// Áëîêèðóåì ïîÿâëåíèå êîíòåêñòíîãî ìåíþ íà êíîïêå ñâåðòûâàíèÿ îêíà
GetCursorPos(CursorPt);
GetWindowRect(hWndApp, WndRect);
CursorPt := Point(CursorPt.X - WndRect.Left, CursorPt.Y - WndRect.Top);
if PtInRect(BtnRect, CursorPt) then
Result := TRUE;
end;

// Ïåðåðèñîâêà êíîïêè ñâåðòûâàíèÿ ïðè èçìåíåíèè ðàçìåðîâ

WM_SIZE :
begin
RedrawWindow(hWndApp, PRect(0), 0, RDW_INVALIDATE);
end;

// Çàâåðøåíèå ðàáîòû ïðèëîæåíèÿ ñ îñâîáîæäåíèåì ðåñóðñîâ

WM_DESTROY, WM_CLOSE :
begin
if InitThemeLibrary and UseThemes then
CloseThemeData(ShlTheme);
RedrawWindow(hWndApp, PRect(0), 0, RDW_INVALIDATE);
PostQuitMessage(0);
end;

end;
end;

begin
DialogBox(hInstance, MAKEINTRESOURCE(101), 0, @DlgProc);
end.

diodio
Извини шлялся по коммандировкам...
Прилагаемый тобой кож ДОЛЖЕН обновлятся после Post; Поскольку BDE поддерживает autocommit.
Есть пару мнений
1 - ошибка совершенно в другом, например в распределении памяти.
2 - ошибка в настройке BDE, например, используеш две разные сессии.
Можешь скинуть весь проект ? Обещаю только некомерческое использование

Поскажите пожалуйста можно ли программно управлять скролбаром DBGrid'a? Если да то как?
Очень надо, т.к. пишу приложение которое управляется сенсорным экраном и не особо удобно прокручивать список нажимая на скролбар. Хотелось бы сделать кнопочки "вперед" , "назад" для перемещения по списку.

Немного запутался в Lookup полях.

Описываю проблему.

В первой таблице хранится информация о договорах, в том числе о валюте и курсе валюты. Во второй таблице хранится список валют. В третьей таблице хранится список курсов с привязкой к таблице валют.

Таблица Contract:
поля ContractId (идентификатор договора), CurrencyId (идентификатор валюты), CurrencyRateId (идентификатор курса валюты)

Таблица Currency:
поля CurrencyId (идентификатор валюты), CurrencyName (наименование валюты)

Таблица CurrencyRate:
поля CurrencyRateId (идентификатор курса валюты), CurrencyId (идентификатор валюты), CurrencyRateValue (курс валюты)

Используется TRxMemoryData, куда согнаны все нужные поля. То есть:

Объект tbmContract:
Поля
ContractId,
CurrencyId,
CurrencyName
(keyfield: CurrencyId, lookupfield: Currency.CurrencyId, result: Currency.CurrencyName)
CurrencyRateId,
CurrencyRateValue.
(keyfield: CurrencyRateId, lookupfield: CurrencyRate.CurrencyId, result: CurrencyRate.CurrencyRateValue)

С CurrencyId и CurrencyName проблем нет, обычное Lookup-поле. А вот дальше непонятно... CurrencyId с одной стороны является результирующим полем, но при этом должно быть и ключевым полем для выбора валюты... Может ли такое быть? Жду советов...

BuddyQ
Если я правильно понял твои записи, то нужно так:

Объект tbmContract:
Поля
ContractId
CurrencyId
CurrencyName (keyfield: CurrencyId, lookupfield: Currency.CurrencyId, result: Currency.CurrencyName)
CurrencyRateId
CurrencyRateValue (keyfield: CurrencyRateId, lookupfield: CurrencyRate.CurrencyRateId, result: CurrencyRate.CurrencyRateValue)

При это подразумевается, что CurrencyRateId в таблице CurrencyRate уникально.

Я опечатался. Конечно, нужно CurrencyRate.CurrencyRateId - так и есть в программе. Вопрос с CurrencyRateId, так как для связки таблицы валют с таблицами курсов я его тоже делаю lookup-полем:

CurrencyRateId (keyfield: CurrencyId, lookupfield: CurrencyRate.CurrencyId, result: CurrencyRate.CurrencyRateId)

Но при запуске получаю ошибку "Отсутствует текущая запись". Вопрос в следующем - можно ли LookupResultField одного lookup-поля использовать как KeyField другого lookup-поля?

BuddyQ

Цитата:

Вопрос в следующем - можно ли LookupResultField одного lookup-поля использовать как KeyField другого lookup-поля?

Можно, но такая организация говорит о непродуманности организации БД.
В приведенном тобой фрагмете такая структура отсутствует, по крайней мере так кажется из того что ты написал, я не заметил где "LookupResultField одного lookup-поля используется как KeyField другого lookup-поля". Либо мы говорим о разных вещах.
Причем я предпологаю что Таблица CurrencyRate имеет ключ из одного поля CurrencyRateId, а не из свяски двух CurrencyRateId и CurrencyId.
Если не разобрался шли фрагмент текстового *.dfm, так будет более надежно.

Граждане друзья товарищи, помогите решить задачку на паскале.



Untitled0.txt.pas : [more]
Код: unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
i1,i2,i3,i4,i5,i6,i7,i8:integer;
o:array of char=('+','-','*','/');
co:array[1..8] of integer;
ii:integer;
summ:real;
s:string;
begin
for i1:=1 to 4 do
begin
co[1]:=i1;
for i2:=1 to 4 do
begin
co[2]:=i2;
for i3:=1 to 4 do
begin
co[3]:=i3;
for i4:=1 to 4 do
begin
co[4]:=i4;
for i5:=1 to 4 do
begin
co[5]:=i5;
for i6:=1 to 4 do
begin
co[6]:=i6;
for i7:=1 to 4 do
begin
co[7]:=i7;
for i8:=1 to 4 do
begin
co[8]:=i8;
summ:=1;
for ii:=1 to 8 do
begin
if co[ii]:=1 then summ:=summ+(ii+1);
if co[ii]:=2 then summ:=summ-(ii+1);
if co[ii]:=3 then summ:=summ*(ii+1);
if co[ii]:=4 then summ:=summ/(ii+1);
end;
if summ:=100 then
begin
s:='1';
for ii:=1 to 8 do
s:=s+o[no][[/no]co[ii]]+IntToStr(ii+1);
s:=s+'=100';
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
Edit1.text:=FloatToStr(s);


end.




Выдаёт.



[Error] Unit1.pas(30): Cannot initialize local variables
[Error] Unit1.pas(63): Type of expression must be BOOLEAN
[Error] Unit1.pas(64): Type of expression must be BOOLEAN
[Error] Unit1.pas(65): Type of expression must be BOOLEAN
[Error] Unit1.pas(66): Type of expression must be BOOLEAN
[Error] Unit1.pas(68): Type of expression must be BOOLEAN
[Error] Unit1.pas(71): Assignment to FOR-Loop variable 'ii'
[Error] Unit1.pas(84): There is no overloaded version of 'FloatToStr' that can be called with these arguments
[Error] Unit1.pas(87): ';' expected but '.' found
[Error] Unit1.pas(91): Declaration expected but end of file found
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'

VidelSamogO

Цитата:

[Error] Unit1.pas(63): Type of expression must be BOOLEAN
[Error] Unit1.pas(64): Type of expression must be BOOLEAN
[Error] Unit1.pas(65): Type of expression must be BOOLEAN
[Error] Unit1.pas(66): Type of expression must be BOOLEAN
[Error] Unit1.pas(68): Type of expression must be BOOLEAN

У тебя здесь операнд присвоения, а не сравнения...

Цитата:

[Error] Unit1.pas(71): Assignment to FOR-Loop variable 'ii'

Тут же написано: у тебя уже есть цикл с переменной "ii", и ты из него опять вызывешь новый цикл с ней же.

Цитата:

[Error] Unit1.pas(84): There is no overloaded version of 'FloatToStr' that can be called with these arguments

FloatToStr - преобразование типа Float в строку, а ты подставляешь аргументом что?

Цитата:

[Error] Unit1.pas(91): Declaration expected but end of file found

Edit1.text:=FloatToStr(s); находится после процедуры. Проверь endы.


Цитата:

[Error] Unit1.pas(30): Cannot initialize local variables

o:array of char=('+','-','*','/'); - определи как const

Дополню:

Код: o:array of char=('+','-','*','/');

ranc
Frodo_Torbins

Спасиб, попробую.

Ребята кто-то использовал какие-то компоненты для Плагиностроения? помогите, никак не могу понять как в визуальном плагине использовать по нескольку форм?

Добавлено:
Ребята кто использовал компоненты для плагиностроения?
У меня вопрос, как в визуальном плагине использовать несколько форм?

Цитата:

Ребята кто-то использовал какие-то компоненты для Плагиностроения? помогите, никак не могу понять как в визуальном плагине использовать по нескольку форм?

Точно так-же как и в основной программе - создаёте набор форм и показываете\скрываете по мере необходимости начиная с момента вызова некой функции в вашем плагине из плагин-менеджера.

Прошу совета.
Делаю базу данных для хранения сведений о курсах повышения квалификации в которых участвуют работники компании. Не встречал ли кто-нибудь готовое решенине как сделать форму или юнит для ввода поовторяющихся событий (по принципу Outlook). То есть например событие повторяется каждый второй четверг в течение следующих 4 месяцев и т.д. В ExtSchedule есть Recurrence Appointment функциональность но она привязана к самому компоненту ExtSchedule. Я бы и купил готовый компонент если бы нашел. Пытался сам сделать но получается больно сложным (сложнее чем вся остальная программа).

saltmi1 у DevExpressa есть компонент cxScheduller. Там можно реализовывать рекурсивные события.

Здравствуйте.

Надо написать приложение, с помощью которого можно подключиться к реестру удаленого компьтера и удалить там определенный ключ.

К реестру удаленого компьютера я подключаюсь. И мне бы хотелось что бы в memo выводился список установленных программ. Как это организовать?

Работаю без TRegistry.

Код:

procedure TForm1.Button2Click(Sender: TObject);
var
Key : HKEY;
SubKey : HKEY;
Buff_key : array[0..1024] of Char;
DataType : DWORD;
Size : DWORD;
begin
//Подключение к реестру удаленого компьютера
RegConnectRegistry('\\Olga', HKEY_LOCAL_MACHINE, Key);

try
//Открытие ключа
RegOpenKeyEx(Key, 'Software\Microsoft\Windows\CurrentVersion\Uninstall',
0, KEY_READ, SubKey)
try
Size := SizeOf(Buff_key);

//Получение данных
RegQueryValueEx(SubKey, 'DisplayName', nil, @DataType, @Buff_key, @Size);

//Вот тут бы выводить значение Buff_key в memo
// ShowMessage(Buf_key);

finally
RegCloseKey(SubKey);
end;
finally
RegCloseKey(Key);
end;
end;

Спасибо за внимание.

Вопрос снят. Разобралась.

f3ka
Спасибо за ответ. Я в спешке написал название неправильно. Я использую ExpressScheduler, но там рекурсивные события встроены в компонент а мне нужно получить к ним выход напрямую например через отдельный диалог.
А то придется все писать руками а уж больно не хочется. Это ведь только довольно маловажная часть программы, больше для удобства юзеров.
У меня день ушел пока я это вот написал только для одной части проблемы:

Цитата:

Procedure TRecurForm.MakeRecurrenceDaily;
var i, h: integer;
begin
RecurrenceListBox.Clear;
h := DaysBetween(StartDateTimePicker.Date,EndStartDateTimePicker.Date) div ComboBox1.Value;
if not (h = 0) then
for I := 0 to h do
begin
RecurrenceListBox.Items.Add(DateToStr(StartDateTimePicker.Date + ComboBox1.Value*i));
end;
end;

После этого понял что и за год не закончу, если все это нужно самому делать с начала. Нужно ведь все это еще и сохранять в базу и ниапример праздники учитывать и т.д. Проще отказаться от этой функцинальности. Но уж очень хочется.

saltmi1
Извини а не пробывал в сорцы заглянуть к Девам?