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

Цитата:

плавно

так было бы лучше

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

psa1974
snike555
Насколько я понимаю, тут должны использоваться винапишные функции, но я не знаю, какие.

DmitryKz

Цитата:

Насколько я понимаю, тут должны использоваться винапишные функции

Ага ж и сообщения тоже . По другому никак.

Цитата:

так было бы лучше

Безусловно, плавная прокрутка - лучше, например так:

Код:
const
EM_GETSCROLLPOS = WM_USER + 221;
EM_SETSCROLLPOS = WM_USER + 222;

procedure TForm4.Timer1Timer(Sender: TObject);
var
pt: TPoint;
si: TScrollInfo;
i: Integer;
begin
si.cbSize:= SizeOf(TScrollInfo);
si.fMask:= SIF_PAGE or SIF_POS or SIF_RANGE;
GetScrollInfo(RichEdit1.Handle, SB_VERT, si);
if ((si.nPage > 0) and (si.nPos + si.nPage < si.nMax)) then
// nPage - размер страницы текста в пикселях
// nMax - размер всего текста в пикселях
begin
SendMessage(RichEdit1.Handle, EM_GETSCROLLPOS, 0, LPARAM(@pt));
pt.Y:= pt.Y+ SpinEdit1.Value;
SendMessage(RichEdit1.Handle, EM_SETSCROLLPOS, 0, LPARAM(@pt));
end;
end;

psa1974

Цитата:

Если надо, могу кинуть исходники, там все прокомментировано

Конечно, буду очень признателен

DmitryKz
Тут Ссылка и исходники и сам плагин - можно попробовать в деле (а папке Docs лежит описание) Что касается исходников - то самое главное место - оконная процедура function NewEditProc(.......): LRESULT; stdcall; - она вызывается редактором для обработки сообщений, и тут то я все и делаю, а конкретно в вспомогательной процедуре RichEditCommonProc.
Редактор Akelpad существует в 2 вариантах - версия 4 с использованием своего собственного окна редактирования (надо по тексту проверять флаг bAkelEdit = true) и версия 3 с использованием RichEdit (флаг bAkelEdit = false), это то, что как раз и надо. Просто сказал об этом, чтоб не запутаться, потому что плагин реализован для обоих вариантов Akelpad

psa1974

Еще небольшое уточнение по Дельфи и RichEdit (на всякий, вдруг понадобится): сообщение EM_SCROLLCARET описано в двух модулях:

RichEdit.pas: EM_SCROLLCARET = WM_USER + 49;
Messages.pas: EM_SCROLLCARET = $00B7;

причем, как видно, по разному . Так вот, правильно оно описано только в модуле Messages.pas. если использовать описание из RichEdit.pas, то оно работать не будет. Чтоб не зависеть от порядка объявления модулей, лучше явно писать в месте использования: Messages.EM_SCROLLCARET

Как определить SID локального пользователя ПК в текстовом виде?

SIgor33
[more=Попробуй так:]unit SPGetSid;

interface

uses
Windows, SysUtils;

function GetCurrentUserSid: String;

implementation

uses uMiscRoutines;

const
HEAP_ZERO_MEMORY = $00000008;
SID_REVISION = 1; // Current revision level

type
PTokenUser = ^TTokenUser;
TTokenUser = packed record
User: TSidAndAttributes;
end;

function ConvertSid(Sid: PSID; pszSidText: PChar; var dwBufferLen: DWORD): BOOL;
var
psia: PSIDIdentifierAuthority;
dwSubAuthorities: DWORD;
dwSidRev: DWORD;
dwCounter: DWORD;
dwSidSize: DWORD;
begin
Result := False;
dwSidRev := SID_REVISION;
if not IsValidSid(Sid) then Exit;
psia := GetSidIdentifierAuthority(Sid);
dwSubAuthorities := GetSidSubAuthorityCount(Sid)^;
dwSidSize := (15 + 12 + (12 * dwSubAuthorities) + 1) * SizeOf(Char);
if (dwBufferLen < dwSidSize) then
begin
dwBufferLen := dwSidSize;
SetLastError(ERROR_INSUFFICIENT_BUFFER);
Exit;
end;
StrFmt(pszSidText, 'S-%u-', [dwSidRev]);
if (psia.Value[0] <> 0) or (psia.Value[1] <> 0) then
StrFmt(pszSidText + StrLen(pszSidText),
'0x%.2x%.2x%.2x%.2x%.2x%.2x',
[psia.Value[0], psia.Value[1], psia.Value[2],
psia.Value[3], psia.Value[4], psia.Value[5]])
else
StrFmt(pszSidText + StrLen(pszSidText),
'%u',
[DWORD(psia.Value[5]) +
DWORD(psia.Value[4] shl 8) +
DWORD(psia.Value[3] shl 16) +
DWORD(psia.Value[2] shl 24)]);
dwSidSize := StrLen(pszSidText);
for dwCounter := 0 to dwSubAuthorities - 1 do
begin
StrFmt(pszSidText + dwSidSize, '-%u',
[GetSidSubAuthority(Sid, dwCounter)^]);
dwSidSize := StrLen(pszSidText);
end;
Result := True;
end;

function ObtainTextSid(hToken: THandle; pszSid: PChar;
var dwBufferLen: DWORD): BOOL;
var
dwReturnLength: DWORD;
dwTokenUserLength: DWORD;
tic: TTokenInformationClass;
ptu: Pointer;
begin
Result := False;
dwReturnLength := 0;
dwTokenUserLength := 0;
tic := TokenUser;
ptu := nil;
if not GetTokenInformation(hToken, tic, ptu, dwTokenUserLength,
dwReturnLength) then
begin
if GetLastError = ERROR_INSUFFICIENT_BUFFER then
begin
ptu := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, dwReturnLength);
if ptu = nil then Exit;
dwTokenUserLength := dwReturnLength;
dwReturnLength := 0;
if not GetTokenInformation(hToken, tic, ptu, dwTokenUserLength,
dwReturnLength) then Exit;
end
else
Exit;
end;
if not ConvertSid((PTokenUser(ptu).User).Sid, pszSid, dwBufferLen) then Exit;
if not HeapFree(GetProcessHeap, 0, ptu) then Exit;
Result := True;
end;

function GetCurrentUserSid: String;
var
hAccessToken: THandle;
bSuccess: BOOL;
dwBufferLen: DWORD;
szSid: array[0..260] of Char;
s: String;
begin
s := '';
bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, hAccessToken);
if not bSuccess then
begin
if GetLastError = ERROR_NO_TOKEN then
bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,
hAccessToken);
end;
if bSuccess then
begin
ZeroMemory(@szSid, SizeOf(szSid));
dwBufferLen := SizeOf(szSid);
if ObtainTextSid(hAccessToken, szSid, dwBufferLen) then
s := szSid;
CloseHandle(hAccessToken);
end;
Result:=s;
end;

end.
[/more]

Подскажите, пожалуйста, по TStringGrid
OnSelectCell - Occurs before a cell in the grid is selected.

А какой обработчик Occurs AFTER a cell in the grid is selected ?
(Нужно выделить участок таблицы и запомнить его для последующих действий - удалить, вставить и т.д.). Спасибо.

ppkp

Цитата:

OnSelectCell - Occurs before a cell in the grid is selected

Насколько я помню, это говорит о том что, можно проверить, а может ли быть ячейка выбрана (т.е. можно запретить выделение определенных ячеек). Используя это событие можно узнать какая ячейка выделена.

Определяйте выделенную область во время действий "удалить, вставить итд", а не после выделения.

DmitryKz
Огромное спасибо, пробую

snike555

Цитата:

Определяйте выделенную область во время действий "удалить, вставить итд", а не после выделения

Спасибо, действительно, так все получается.

Ситуация такая:
Есть форма, на ней MDIChild окна, когда нажимаешь "свернуть" у MDIChild форма сворачивается к левому краю главного окна, мне нужно чтобы это было не так, а форма вовсе становилась невидимой. Решал эту проблему так:

procedure TMDIchildForm.WMSize(var Msg: TWMSize);
begin
if Visible then
begin
if Msg.SizeType = SIZE_MINIMIZED then
ShowWindow(Handle, SW_HIDE);
inherited;
if (Msg.SizeType = SIZE_MINIMIZED) and (ListIndex = form1.Tabs.TabIndex) then
form1.Tabs.TabIndex := -1;
end
else
inherited;
end;

Не знаю других вариантов, если они есть просьба подсказать их, потому что мой вариант в некоторых случаях вызывает AV екзепшен (при Destroy в непонятных мне случаях вызывается ресайз).
Сейчас переношу проект на Delphi2010, возможно там появились какие-то возможности сделать это по другому.

ЗЫ все посты типа "этот парень нафлудил" - являются флудом

Здравствуйте. Пожалуйста помогите создать приложение , в котором по нажатию кнопки "шар" в клиентской области формы случайным образом периодически появляются и исчезают разноцветные окружности(выбор цвета случаен). Через каждые 30 секунд раздается звуковой сигнал. Форма меняет цвет. Через две минуты появляется вопрос о продолжении работы.

pakusya
Это задачка явно на работу с таймером TTimer.

snike555
Может так поможет...

Код:
begin
if Visible and (Msg.SizeType = SIZE_MINIMIZED) then
begin
ShowWindow(Handle, SW_HIDE);
if Assigned(form1) and (ListIndex = form1.Tabs.TabIndex) then form1.Tabs.TabIndex := -1;
end
else
inherited;
end;

V1s1ter
pakusya на самом деле - она

Знатоки, подскажите плиз, как убрать мерцание при закрытии главной формы. Ситуация следующая: после ввода неверного пароля на форме доступа (появлятся при OnShow главного окна) при закрытии главного окна оно появляется на несколько секунд - очень визуально не красиво

DoubleBuffered=true ?

всем снова привет. есть консольное приложение на winsock на подобии чата
http://articles.org.ru/cfaq/index.php?qid=2207

Код: program winsock_server;
//Простейшее приложение-сервер.
//Сокеты работают в блокирующем режиме.
//На каждое соединение создается отдельный поток.
{$apptype console}
uses
sysutils,
winsock,
windows;
var
vwsadata : twsadata;
vlistensocket,vsocket : tsocket;
vsockaddr : tsockaddr;
trid : thandle;
const
cport = word(33);
csigexit = 'q';
//Процедура отдельного потока для каждого клиента.
procedure socketthread;
var sockname : tsockaddr;
abuf : array of char;
vbuf : string;
vsize : integer;
s :tsocket;
bufsize : integer;
begin
s := vsocket;
if s = invalid_socket then exit;
vsize := sizeof(tsockaddr);
getpeername(s, sockname, vsize);
writeln(format('client accepted, remote address [%s].',[inet_ntoa (sockname.sin_addr)]));
//Определяем размер буфера чтения для сокета
vsize := sizeof(bufsize);
getsockopt(s,sol_socket,so_rcvbuf,pchar(@
bufsize),vsize);
writeln(format('receive buffer size [%d]',[bufsize]));
setlength(abuf,bufsize);
repeat
//Получаем данные. Процедура работает в блокирующем режиме,
//таким образом следующая строка кода не получит управление,
//пока не поступят данные от клиента.
vsize := recv(s,abuf[0],bufsize,0);
if vsize<=0 then break;
setlength(vbuf,vsize);
lstrcpyn(@vbuf[1],@abuf[0],vsize);
writeln(format('received from cleint: %s',[vbuf]));
until vbuf = 'q';
writeln(format('client disconnected, remote address [%s].',[inet_ntoa(sockname.sin_addr)]));
setlength(abuf,0);
closesocket(s);
end;

begin
writeln('starting application...');
//Объявляем, что программа будет использовать windows sockets.
if wsastartup($101,vwsadata)<>0 then halt(1);
writeln('using windows sockets.');
//Создаем прослушивающий сокет.
vlistensocket := socket(af_inet,sock_stream,ipproto_ip);
writeln(format('creating socket on port [%d].',[cport]));
if vlistensocket = invalid_socket then halt(1);
fillchar(vsockaddr,sizeof(tsockaddr),0);
vsockaddr.sin_family := af_inet;
vsockaddr.sin_port := htons(cport);
vsockaddr.sin_addr.s_addr := inaddr_any;
writeln('binding socket...');
//Привязываем адрес и порт к сокету.
if bind(vlistensocket,vsockaddr,sizeof(tsockaddr)) <> 0
then halt(1);
//Начинаем прослушивать.
if listen(vlistensocket,somaxconn) <> 0
then halt(1);
writeln('socket status: listening.');
repeat
//Ожидаем подключения.
vsocket := accept(vlistensocket,nil,nil);
//Клиент подключился, запускаем новый процесс на соединение.
createthread(nil,0,@socketthread,0,0,trid);
until false;
closesocket(vlistensocket);
wsacleanup;
end.

надо реализовать список показанных окон в программе...в силу необходимости MDI окна уже не подходят...так вот вопрос...будет ли сильно напряжно ставить на ежесекундный таймер это

Код:
For I := 0 to Screen.FormCount - 1 do
if Screen.Forms[I].Visible then
memo2.Lines.Add(Screen.Forms[I].Caption);

mdid
не проще на форму в момент visible (invisible)
добавлять/удалять в мемо?

та может так и проще...вот только провтыкать могу при новом документе..зато однозначно не будет нагрузки

Как run-time определить версию Windows Installer и Net Framework

SIgor33

В MiTeC System Information Component Suite версии определяются чтением из реестра путей к файлам msi.dll и mscorlib.tlb и получением их версий файлов.
Только файлов mscorlib.tlb может быть несколько, поэтому нужно получать версию из них всех, и брать наиболее старшую версию.

mdid
В Screen.OnActiveFormChange можно ловить появление новых форм и навешивать им обработчик OnDestroy.
Delta RuBoard
То, что вы хотели повесить на кнопку, лучше впихнуть в отдельный поток.

Подскажите:
Пишу
Const
OneKB = 1024;
OneMB = OneKB * 1000;
...
4700_DVDRom = OneMB * 4700;

Компилятор тычет на 4700_DVDRom и говорит "Overflow in conversion or arithmetic operation"

Как мне сказать компилятору, что 4700_DVDRom должен быть Int64???

Спасибо.