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

» Вопросы по Delphi

Автор: RUNaum
Дата сообщения: 28.02.2006 16:14

Цитата:
Народ, кто-нибудь использовал AQtime v4.9 (just released with tight Borland Developer Studio integration. Profile applications without leaving the IDE) от http://www.automatedqa.com/products/aqtime/index.asp для обнаружения утечек памяти и ресурсов?
Интересует, насколько он хорош для этих целей? Удобство работы с этим пакетом? Есть ли более легковесные аналоги?


memproof не плох для выявления утечек, но профайлера там нету. зато легковесен =) а AQTime я жаль последнего ломанного не нашел. профайлер офигенный. вот бы кто-нить посоветовал free профайлеры под дельфю (D7 / D9 / D2006). либо может кто кряком под AQTime поделится? )
Автор: vshersh
Дата сообщения: 28.02.2006 16:16
BABAYKA
Напиши вместо

Код: DataModule1.pFIBDatabase1.Connected:=True;
Автор: ast1
Дата сообщения: 28.02.2006 16:38
BABAYKA


Цитата:


и указывает на строчку:
DataModule1.pFIBDatabase1.ConnectParams.UserName := FLogin.EdLogin.Text;


База у тебя стартует c Connected:=True; или нет ?

Попробуй откомпелировать, с отключенноей базой
или перед этой строчкой поставит
DataModule1.pFIBDatabase1.Connected:=False;
Автор: BABAYKA
Дата сообщения: 28.02.2006 16:52
ast1

Цитата:
База у тебя стартует c Connected:=True; или нет ?


Вот именно...УРА!!!....Я ранее искал собаку в этом месте, но криво был выставлен коннект (спасибо RomanTim поправил)...в результате по запарке оставил включеным датабазу....сейчас поправил и все ОК!!! СПАСИБО ВСЕМ БОЛЬШОЕ ЗА ПОМОЩЬ...!!!!
Автор: aplex
Дата сообщения: 28.02.2006 19:02
Прога была написана на Д4(см мой пост(Apleks) на стр77). В принципе нормально компилируется на Д7, только работает потом несколько не корректно. В частности, как догадываюсь, не может сделать UnhookWindowsHookEx(hhk); При компиляции выдаётся куча предупреждений. Может быть в сумме и получается одна большая проблема. Предупреждения для .dll такие:

Код:
library P;
uses
Windows, Messages, Commctrl;
{$R *.res}
..............
function WP(.........................): integer; stdcall;
var .................
lvi: LV_ITEM;
buf: array[0..256] of byte;
pt: record x,y: integer; end;
....
// далее идут ругательства
// [Warning] P.dpr(61): Unsafe type 'pszText: PAnsiChar'
// на подобные выражения:
lvi.pszText:=@buf[0];
// [Warning] P.dpr(61): Unsafe code '@ operator'
// практически везде где встречается оператор '@'
// [Warning] P.dpr(72): Unsafe type 'PChar'
// на подобные выражения (т.е. везде где встречается PChar):
RegCreateKeyEx(HKEY_CURRENT_USER,
PChar('fghfg'+chr(wParam+ord('0'))), 0,
nil, 0, KEY_ALL_ACCESS, nil, key1, @dw);
...........
function DllHookProc(code: integer; wParam, lParam: Cardinal): Cardinal; stdcall;
var hi: Cardinal;
// [Warning] P.dpr(109): Unsafe type 'Pointer' // на выражение:
lpMsgBuf: Pointer;
.........
Автор: RomanTim
Дата сообщения: 28.02.2006 20:41
aplex
Unsafe-предупреждения говорят о том, что потенциально код может испортить память, только вот без Pointer, PChar, @ и т.п. с WinAPI не много наработаешь. Предупреждение выдаются на сам факт наличия этих типов и операций, на работоспособности они не сказывааются. Я у себя эти предупреждения просто сразу выключаю и настройки проекта запоминаю как дефолтные.

По поводу UnhookWindowsHookEx -

Код: if not UnhookWindowsHookEx(...) then
ShowMessage(IntToStr(GetLastError));
Автор: relictus
Дата сообщения: 01.03.2006 08:22

Цитата:
memproof не плох для выявления утечек, но профайлера там нету. зато легковесен =) а AQTime я жаль последнего ломанного не нашел. профайлер офигенный. вот бы кто-нить посоветовал free профайлеры под дельфю (D7 / D9 / D2006). либо может кто кряком под AQTime поделится? )

А вот тут посмотри http://forum.ru-board.com/topic.cgi?forum=35&topic=7273&start=160#lt
Автор: mainstream
Дата сообщения: 01.03.2006 10:38
Привет.
Простите за ламерский вопрос, просто ни разу не сталкивался.
Как мне сделать прозрачный компонент, наследник TCustoPanel, у меня имеются 2 TBitmap, в которых я собственно и рисую свой контрол, а в паинте просто копиректом переношу изображение на канву. Юзаю я PngImage.pas, и хочу чтобы контрол отображал прозрачную PNG'ху, но естественно после простого копирования PNG на битмап, а потом на канву, никакой прозрачности не получается, как её можно замутить?
Спасибо.

Добавлено:
Нашел на сорцах ру вот такую процедуру:

Код:
procedure DrawTransparentBmp(Cnv: TCanvas; x,y: Integer; Bmp: TBitmap;
clTransparent: TColor);
var
bmpXOR, bmpAND, bmpINVAND, bmpTarget: TBitmap;
oldcol: Longint;
begin
try
bmpAND := TBitmap.Create;
bmpAND.Width := Bmp.Width;
bmpAND.Height := Bmp.Height;
bmpAND.Monochrome := True;
oldcol := SetBkColor(Bmp.Canvas.Handle, ColorToRGB(clTransparent));
BitBlt(bmpAND.Canvas.Handle, 0,0,Bmp.Width,Bmp.Height, Bmp.Canvas.Handle,
0,0, SRCCOPY);
SetBkColor(Bmp.Canvas.Handle, oldcol);

bmpINVAND := TBitmap.Create;
bmpINVAND.Width := Bmp.Width;
bmpINVAND.Height := Bmp.Height;
bmpINVAND.Monochrome := True;
BitBlt(bmpINVAND.Canvas.Handle, 0,0,Bmp.Width,Bmp.Height,
bmpAND.Canvas.Handle, 0,0, NOTSRCCOPY);

bmpXOR := TBitmap.Create;
bmpXOR.Width := Bmp.Width;
bmpXOR.Height := Bmp.Height;
BitBlt(bmpXOR.Canvas.Handle, 0,0,Bmp.Width,Bmp.Height, Bmp.Canvas.Handle,
0,0, SRCCOPY);
BitBlt(bmpXOR.Canvas.Handle, 0,0,Bmp.Width,Bmp.Height,
bmpINVAND.Canvas.Handle, 0,0, SRCAND);

bmpTarget := TBitmap.Create;
bmpTarget.Width := Bmp.Width;
bmpTarget.Height := Bmp.Height;
BitBlt(bmpTarget.Canvas.Handle, 0,0,Bmp.Width,Bmp.Height, Cnv.Handle, x,y,
SRCCOPY);
BitBlt(bmpTarget.Canvas.Handle, 0,0,Bmp.Width,Bmp.Height,
bmpAND.Canvas.Handle, 0,0, SRCAND);
BitBlt(bmpTarget.Canvas.Handle, 0,0,Bmp.Width,Bmp.Height,
bmpXOR.Canvas.Handle, 0,0, SRCINVERT);
BitBlt(Cnv.Handle, x,y,Bmp.Width,Bmp.Height, bmpTarget.Canvas.Handle, 0,0,
SRCCOPY);
finally
bmpXOR.Free;
bmpAND.Free;
bmpINVAND.Free;
bmpTarget.Free;
end;
end;
Автор: YuRRiX
Дата сообщения: 02.03.2006 08:19
Кто-нибудь знает как можно отправлять сообщения по сети по аналогии [net send]?
зарание благодарен.
Автор: mainstream
Дата сообщения: 02.03.2006 10:30
YuRRiX, что значит по аналогии, ты хочешь заюзать net send из своей проги, или тебе утилита net не катит вобсче? Если net подходит то юзай ShellExecute.
Автор: SERGE_BLIZNUK
Дата сообщения: 02.03.2006 11:40
mainstream

Цитата:
сделать прозрачный компонент


Вот, по вашей просьбе нашёл статью в Delphi World
"Полупрозрачная форма в Win2000"

Подробнее - [more]
--------------------------------------------------------------------------------

Обнаружил в Windows 2000 полноценную реализацию полупрозрачности:


Код:
const
WS_EX_LAYERED = $80000;

LWA_COLORKEY = 1;
LWA_ALPHA = 2;

function SetLayeredWindowAttributes(
hwnd : HWND; // handle to the layered window
crKey : TColor; // specifies the color key
bAlpha : byte; // value for the blend function
dwFlags : DWORD // action
): BOOL; stdcall;

function SetLayeredWindowAttributes; external 'user32.dll';

procedure TForm1.FormCreate(Sender: TObject);
begin
if SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE)
or WS_EX_LAYERED) = 0 then
ShowMessage(SysErrorMessage(GetLastError));

if not SetLayeredWindowAttributes(Handle, 0, 128, LWA_ALPHA) then
// ^^^ степень прозрачности
// 0 - полная прозрачность
// 255 - полная непрозрачность
ShowMessage(SysErrorMessage(GetLastError));
end;




Есть более продвинутые возможности (например, альфа-канал в битмапе)
http://msdn.microsoft.com/isapi/msdnlib.idc?theURL=/library/techart/layerwin.htm



unit TransparentWnd;

interface

uses
Windows, Messages, Classes, Controls, Forms;

type
_Percentage = 0..100;

TTransparentWnd = class(TComponent)
private
{ Private declarations }
protected
{ Protected declarations }
_percent: _Percentage;
_auto: boolean;
User32: HMODULE;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

//These work on a Handle
//It doesn't change the Percent Property Value!
procedure SetTransparentHWND(hwnd: THandle; percent : _Percentage);

//These work on the Owner (a TWinControl decendant is the Minumum)
//They don't change the Percent Property Value!
procedure SetTransparent; overload;
procedure SetTransparent(percent : _Percentage); overload;

procedure SetOpaqueHWND(hwnd : THandle);
procedure SetOpaque;
published
{ Published declarations }
//This works on the Owner (a TWinControl decendant is the Minumum)
property Percent: _Percentage read _percent write _percent default 0;

property AutoOpaque: boolean read _auto write _auto default false;
end;

procedure register;

implementation

const LWA_ALPHA = $2;
const GWL_EXSTYLE = (-20);
const WS_EX_LAYERED = $80000;
const WS_EX_TRANSPARENT = $20;

var
SetLayeredWindowAttributes: function (hwnd: LongInt; crKey: byte;
bAlpha: byte; dwFlags: LongInt): LongInt; stdcall;

constructor TTransparentWnd.Create(AOwner: TComponent);
begin
inherited;

User32 := LoadLibrary('USER32.DLL');
if User32 <> 0 then
@SetLayeredWindowAttributes := GetProcAddress(User32, 'SetLayeredWindowAttributes')
else
SetLayeredWindowAttributes := nil;
end;

destructor TTransparentWnd.Destroy;
begin
if User32 <> 0 then
FreeLibrary(User32);

inherited;
end;

procedure TTransparentWnd.SetOpaqueHWND(hwnd: THandle);
var
old: THandle;
begin
if IsWindow(hwnd) then
begin
old := GetWindowLongA(hwnd,GWL_EXSTYLE);
SetWindowLongA(hwnd, GWL_EXSTYLE, old and ((not 0)-WS_EX_LAYERED));
end;
end;

procedure TTransparentWnd.SetOpaque;
begin
Self.SetOpaqueHWND((Self.Owner as TWinControl).Handle);
end;

procedure TTransparentWnd.SetTransparent;
begin
Self.SetTransparentHWND((Self.Owner as TWinControl).Handle, Self._percent);
end;

procedure TTransparentWnd.SetTransparentHWND(hwnd: THandle; percent : _Percentage);
var
old: THandle;
begin
if (User32 <> 0) and (Assigned(SetLayeredWindowAttributes)) and (IsWindow(hwnd)) then
if (_auto=true) and (percent=0) then
SetOpaqueHWND(hwnd)
else
begin
percent := 100 - percent;
old := GetWindowLongA(hwnd, GWL_EXSTYLE);
SetWindowLongA(hwnd, GWL_EXSTYLE, old or WS_EX_LAYERED);
SetLayeredWindowAttributes(hwnd, 0, (255 * percent) div 100, LWA_ALPHA);
end;
end;

procedure TTransparentWnd.SetTransparent(percent: _Percentage);
begin
Self.SetTransparentHWND((Self.Owner as TForm).Handle, percent);
end;

procedure register;
begin
RegisterComponents('Win32', [TTransparentWnd]);
end;

end.
Автор: vshersh
Дата сообщения: 02.03.2006 13:16
YuRRiX

Код: NetMessageBufferSend
The NetMessageBufferSend function sends a buffer of information to a registered message alias.

NET_API_STATUS NetMessageBufferSend(
LPCWSTR servername,
LPCWSTR msgname,
LPCWSTR fromname,
LPBYTE buf,
DWORD buflen
);
Автор: mainstream
Дата сообщения: 02.03.2006 14:07
SERGE_BLIZNUK
Спасибо за ответ, но это совсем не то, прозрачные окна мне не интересны.
Меня интересует только один вопрос: как сделать компонент наследник TCustomPanel, канва которого будет прозрачной, например в паинте нарисовать только рамку, чтобы непрозрачной была только она.
Автор: SERGE_BLIZNUK
Дата сообщения: 02.03.2006 14:34
mainstream
ага.. тогда я вам ничем не смогу помочь... по крайней мере, сейчас...
Автор: YuRRiX
Дата сообщения: 02.03.2006 15:24
2 mainstream. net send конечно хорошо, но невозможно контролировать ответ (если служба сообщений остановлена например...)
2 vshersh, спасибо, Все замечательно работает!
Автор: mainstream
Дата сообщения: 02.03.2006 15:42
YuRRiX
Согласен
Автор: MrZeRo
Дата сообщения: 02.03.2006 15:48
mainstream

Цитата:
как сделать компонент наследник TCustomPanel, канва которого будет прозрачной, например в паинте нарисовать только рамку, чтобы непрозрачной была только она.

Для этого есть компонент TBevel.

Цитата:

Description
Use TBevel to create beveled boxes, frames, or lines. The bevel can appear raised or lowered.

Автор: mainstream
Дата сообщения: 02.03.2006 16:56
MrZeRo
Дело в том что мне нужна не только рамка, а рисование немного посерьезнее, это я так сказать для примера. В тоже время мне нужен компонент, который сам является окном(т.е. наследник TWinControl), а не наследник TGraphicControl, т.к. потомки TGraphicControl, не получают сообщений о действиях мыши.
Если в двух словах, то мне нужен компонент-наследник, чего-нибудь из TWinControl с прозрачной канвой.
Автор: MrZeRo
Дата сообщения: 02.03.2006 17:27

Цитата:
потомки TGraphicControl, не получают сообщений о действиях мыши

Получают. Например,

Цитата:

TImage = class(TGraphicControl)
...
published
property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;

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

Цитата:

The SetLayeredWindowAttributes function sets the opacity and transparency color key of a layered window.

Надо сначала установить флаг LAYERED:

Цитата:

SetWindowLong(Handle, GWL_EXSTYLE, AStyle or WS_EX_LAYERED);

но для нее

Цитата:

Minimum operating systems Windows 2000

Зачитай в MSDN про эти функции и попробуй.
Автор: makbeth
Дата сообщения: 03.03.2006 05:25
mainstream
Можно попробовать переопределить WM_ERASEBKGND:

Код:
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result:=1;
end;
Автор: ShIvADeSt
Дата сообщения: 03.03.2006 05:39
mainstream

Цитата:
Если в двух словах, то мне нужен компонент-наследник, чего-нибудь из TWinControl с прозрачной канвой.

А ыт возьми у них реализацию метода Paint и сделай аналогичную для WinControl.
Автор: mainstream
Дата сообщения: 03.03.2006 09:46
MrZeRo
Я немного не так выразился, конечно же сообщения от мыши они получают, просто если делать потомка TGraphicControl то вот этот код не работает:

Код: Perform(WM_SYSCOMMAND, SC_MOVE+2,0)
Автор: MrZeRo
Дата сообщения: 03.03.2006 10:10
mainstream
Непонятно, какая связь кода
Цитата:
Perform(WM_SYSCOMMAND, SC_MOVE+2,0)
с прозрачностью окна.
Константы со значением SC_MOVE+2 для события WM_SYSCOMMAND вообще нет, это что-то недокументированное?
Опиши подробнее, какая функциональность требуется.
Автор: mainstream
Дата сообщения: 03.03.2006 12:53
MrZeRo
Требуется контрол который можно в рантайме двигать и ресайзить мышой плюс ковсему он должен быть прозрачным. Например в паинте нарисовал окружность, и её можно будет двагать по форме и все что под окружностью должно быть видно.
А этот код мне посоветовал gpi еще на 77 стр. Использую его для таскания контрола мышой:

Код:
procedure TMyPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
ReleaseCapture;
if(Button=mbLeft)then Perform(WM_SYSCOMMAND, SC_MOVE+2,0)
end;
Автор: MrZeRo
Дата сообщения: 03.03.2006 14:06
mainstream
Мне кажется, не получится то, что ты хочешь. По крайней мере, это будет не TWinControl. Оконным должен быть контрол, на котором рисуются объекты, и он должен обрабатывать все клавиши и нажатия мышью, в ее оконной процедуре должны отрисовываться все элементы. Я заглянул в исходники FastReport, у них дизайнер сделан в таком духе.
Автор: mainstream
Дата сообщения: 03.03.2006 15:17
Пусть будет не TWinControl, а как тогда его таскать и ресайзить?
Автор: volax
Дата сообщения: 03.03.2006 17:15
Сорри, не туда написал...
Автор: makbeth
Дата сообщения: 06.03.2006 05:32
mainstream

Цитата:
...Использую его для таскания контрола мышой...

а смысл испльзования Perform и вообще сообщений в данном случае? Не проще ли сразу вызвать метод перемещения (Left:=Left + 2, например)? Фактически Perform вызывает процедуру WindowProc контрола, а та - обработчик нужного сообщения, НЕ помещая сообщения в очередь.
Вот можно посмотреть исходники Size components. Вроде то что нужно.
Автор: YuRRiX
Дата сообщения: 06.03.2006 10:36
Подскажите пожалуйста как в делфях отлавить момент подключения стороннего юзверя к NT системе, учетную запись с которой он пытается войти в систему и его IP?
Автор: MrZeRo
Дата сообщения: 06.03.2006 11:48
mainstream

Цитата:
Пусть будет не TWinControl, а как тогда его таскать и ресайзить?

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

Страницы: 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768

Предыдущая тема: Вероятность одинакового CRC32


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