Секция 7 из 8 - Предыдущая - Следующая
Все секции
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
охpана уже pугается. Но код - выдpан из pаботающих исходников.
Author>:
Боpисов Олег Николаевич (ZB)
panterra@sbtx.tmn.ru
(2:5077/5)
.
Q>:
Как работать с формой, куда динамически передаются страницы (PageControl) из
форм-хранителей (с использованием наследования).
A>:
Кидаю проект-болванку, сделанную перед началом работы над основным:
=== Cut ===
unit Unit1; //базовая форма хранителя страницы
interface
uses ...
type
TBPgFrm = class(TForm)
Panel1: TPanel;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Label1: TLabel;
public
function PgInit: boolean; virtual;
function PgValid: boolean; virtual;
end;
implementation
{$R *.DFM}
function TBPgFrm.PgInit: boolean;
begin
result:= MessageDlg(Label1.Caption+': PgInit',
mtConfirmation, mbOkCancel, 0)=mrOK;
end;
function TBPgFrm.PgValid: boolean;
begin
result:= MessageDlg(Label1.Caption+': PgValid',
mtConfirmation, mbOkCancel, 0)=mrOK;
end;
end.
unit Unit2; //главная форма проекта; содержит первую сраницу
interface //и кнопки Cancel, Prev & Next/Finish.
uses ...
type
TPagesDlg = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Prev: TButton;
CancelBtn: TButton;
Next: TButton;
Label1: TLabel;
procedure CancelBtnClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure NextClick(Sender: TObject);
procedure PrevClick(Sender: TObject);
private
Frms: TList;
procedure AddForms;
end;
var PagesDlg: TPagesDlg;
implementation
uses Unit1, Unit3, Unit4, Unit5;
{$R *.DFM}
procedure TPagesDlg.AddForms; //размещение динамических страниц
var i: word;
begin
Frms:= TList.Create;
Frms.Add(TBPgFrm1.Create(Self));
Frms.Add(TBPgFrm2.Create(Self));
for i:= 0 to 1 do TBPgFrm(Frms[i]).TabSheet1.PageControl := PageControl1
end;
procedure TPagesDlg.CancelBtnClick(Sender: TObject);
begin Close; end;
procedure TPagesDlg.FormDestroy(Sender: TObject);
var i: word;
begin
for i:= Frms.Count-1 downto 0 do TBPgFrm(Frms[i]).Free;
Frms.Free;
end;
procedure TPagesDlg.NextClick(Sender: TObject);
var
i: word;
vi: Boolean;
begin
Next.Enabled:= false;
if PageControl1.PageCount=1 then AddForms;
i:= PageControl1.ActivePage.PageIndex;
if i=0 then vi:= true else vi:= TBPgFrm(Frms[i-1]).PgValid;
if vi then with PageControl1 do if i=PageCount-1 then begin
CancelBtnClick(Sender); exit;
end else begin
ActivePage:= FindNextPage(ActivePage, True, false);
if ActivePage.PageIndex=PageCount-1 then Next.Caption:= 'Finish';
Prev.Enabled:= true;
if TBPgFrm(Frms[i]).PgInit then Next.Enabled:= true else PrevClick(Sender);
end else Next.Enabled:= true;
end;
procedure TPagesDlg.PrevClick(Sender: TObject);
begin
Prev.Enabled:= false;
with PageControl1 do begin
ActivePage:= FindNextPage(ActivePage, false, false);
Prev.Enabled:= ActivePage.PageIndex>0;
end;
Next.Caption:= 'Next'; Next.Enabled:= true;
end;
end.
unit Unit3; //наследник с RadioGroup.
interface
uses ...
type
TBPgFrm3 = class(TBPgFrm)
RadioValid: TRadioGroup;
public
function PgValid: boolean; override;
end;
implementation
{$R *.DFM}
function TBPgFrm3.PgValid: boolean;
begin
result:= RadioValid.ItemIndex=0;
end;
end.
unit Unit4; // наследник с CheckBox.
interface
uses ...
type
TBPgFrm2 = class(TBPgFrm)
CheckValid: TCheckBox;
public
function PgValid: boolean; override;
end;
implementation
{$R *.DFM}
function TBPgFrm2.PgValid: boolean;
begin
result:= CheckValid.Checked;
end;
end.
=== Cut ===
Author>:
Михаил Алявдин (Michail Alyavdin)
(2:5030/198.8)
.
Q>:
Вопрос. Имеется иерархия форм, помещенная в репозиторий. У некоторых
из этих форм имеются добавленные проперти в паблишед секции. Как сделать
эти проперти видимыми инспектору для визуальной установки ? (как в рамках
самой формы - темплейта, так и в порожденной по инхерит форме) - пока эти
свойства вообще не видны, хотя, естественно, доступны и работают (ведут
себя как public, а не published).
A>:
Описываешь свой класс:
TCoolForm = class(TCustomForm)
...
pulished
// Мои разные свойства
end;
Регистрируешь его (компоненты регистрировать умеешь?):
procedure Register;
begin
RegisterCustomModule(TCoolForm, TCustomModule);
end;
Что тут идет вторым параметром я не разбирался, но катит и так. По-моему,
это класс, с помощью которого можно кустомизировать Design-Time popup-menu
и все такое. Короче - смотри DsgnIntf.pas
В модуле пишешь:
TMyForm = class(TCoolForm)
...
Это тонкое место. Базовый класс должен быть "известен" системе - не катит
даже прямой наследник TCoolForm (если он не зарегистрирован) - иначе
твои property "не подцепятся". Т.е., очевидно, парсинг текста в
Design-time вообще не производится ( плохо :( ). Самое разумное -
подготовить template и занести его в репозиторий - ну это ты и так делаешь.
Все.
Да, чуть не забыл, справедливо для D3. Другие версии не знаю.
Author>:
Max Rusov
(2:5030/456.1)
.
Q>:
Как сделать чтобы при событиях моя программа отпpавляла кому-либо сообщение
на мой компьютеp.
A>:
Если только послать, то проще всего, пожалуй...
Win32:
F1 "NetMessageBufferSend"
Win16: Почему-то неописан, но руками наковырял...
function NetMessageBufferSend(
Zero1, Zero2: Word;
WhoTo: PChar;
Buffer: PChar; BufSize: Word): Integer; external 'NETAPI' index 525;
"Кому" может быть '*' == всем.
Author>:
Александр Петросян(PAF, Alexander Petrosyan), Зеленоград.
(2:5020/468.8)
.
Q>:
Как написать DLL, которую можно было-бы выполнить с помощью RunDll, RunDll32?
A>:
Вы должны определить в программе вызываемую снаружи функцию.
Функция должна быть __stdcall (или WINAPI, что то же самое ;)) и иметь
четыре аргумента. Первый - HWND окна, порождаемого rundll32 (можно
использовать в качестве owner'а своих dialog box'ов), второй - HINSTANCE
задачи, третий - остаток командной строки (LPCSTR, даже под NT),
четвертый - не знаю ;). Например,
===
int __stdcall __declspec(dllexport) Test
(
HWND hWnd,
HINSTANCE hInstance,
LPCSTR lpCmdLine,
DWORD dummy
)
{
MessageBox(hWnd, lpCmdLine, "Command Line", MB_OK);
return 0;
}
===
rundll32 test.dll,_Test@16 this is a command line
===
выдаст message box со строкой "this is a command line".
Author>:
Oleg Moroz
(2:5020/701.22)
Function Test(
hWnd: Integer;
hInstance: Integer;
lpCmdLine: PChar;
dummy: Longint
): Integer; StdCall; export;
begin
Windows.MessageBox(hWnd, lpCmdLine, 'Command Line', MB_OK);
Result := 0;
end;
Editor>:
Akzhan Abdulin
(2:5040/55)
Давненько я ждал эту инфоpмацию! Сел пpовеpять и наткнулся на очень
забавную вещь. А именно -- пусть у нас есть исходник на Си пpимеpно такого
вида:
int WINAPI RunDll( HWND hWnd, HINSTANCE hInstance, LPCSTR lpszCmdLine, DWORD
dummy )
......
int WINAPI RunDllW( HWND hWnd, HINSTANCE hInstance, LPCWSTR lpszCmdLine, DWORD
dummy )
......
и .def-файл пpимеpно такого вида:
EXPORTS
RunDll
RunDllA=RunDll
RunDllW
то rundll32 становится pазбоpчивой -- под НТ вызывает UNICODE-веpсию. Под
95, pазумеется, ANSI. Rulez.
Author>:
Alexey A Popoff
pvax@glas.apc.org, posp@ccas.ru
http://www.ccas.ru/~posp/popov/pvax.html
(2:5020/487.26)
Думаю, что переобьяснять в стиле ObjectPascal нужды нет.
.
Q>:
Что нужно давать WSAAsyncSelect в качестве параметра handle если тот
запускается и используется в dll (init) и никакой формы (у которой
можно было бы взять этот handle) в этом dll не создается. Что бы
такого сделать чтобы работало?
A>:
const WM_ASYNCSELECT = WM_USER+0;
TNetConnectionsManager = class(TObject)
protected
FWndHandle : HWND;
procedure WndProc( var MsgRec : TMessage );
...
end;
constructor TNetConnectionsManager.Create
begin
inherited Create;
FWndHandle := AllocateHWnd(WndProc);
...
end;
destructor TNetConnectionsManager.Destroy;
begin
...
if FWndHandle<>0 then DeallocateHWnd(FWndHandle);
inherited Destroy;
end;
procedure TNetConnectionsManeger.WndProc( var MsgRec : TMessage );
begin
with MsgRec do
if Msg=WM_ASYNCSELECT then WMAsyncSelect(MsgRec)
else DefWindowProc( FWndHandle, Msg, wParam, lParam );
end;
Но pекомендую посмотpеть WinSock2, в котоpом можно:
WSAEventSelect( FSocket, FEventHandle, FD_READ or FD_CLOSE );
WSAWaitForMultipleEvents( ... );
WSAEnumNetworkEvents( FSocket, FEventHandle, lpNetWorkEvents );
То есть, обойтись без окон и без очеpеди сообщений windows, а заодно иметь
возможность pаботать и с IPX/SPX, и с netbios.
Свой winsock2.pas я вчеpа кинул в RU.DELPHI.DB, если кто имеет такой из дpугих
источников - свистните погpомче.
Author>:
Alex Konshin
alexk@msmt.spb.su
(2:5030/217)
.
Q>:
Как правильно в Win32 отслеживать запуск второй копии программы?
A>:
FindWindow является неполным решением (если меняется заголовок окна или
если есть другая программа с таким же заголовком или типом окна).
Вторично: медленно.
Лениво пользовать семафоры, покажу на именованных мутексах (семафоры с двумя
состояниями).
Unit OneInstance32;
interface
implementation
uses
Forms;
var
g_hAppMutex: THandle;
function OneInstance: boolean;
var
g_hAppCritSecMutex: THandle;
dw: Longint;
begin
g_hAppCritSecMutex := CreateMutex( nil, true, PChar(Application.Title +
'.OneInstance32.CriticalSection') );
// if GetLastError - лениво писать
g_hAppMutex := CreateMutex( nil, false, PChar(Application.Title +
'OneInstance32.Default') );
dw := WaitForSingleObject( g_hAppMutex, 0 );
Result := (dw <> WAIT_TIMEOUT);
ReleaseMutex( g_hAppCritSecMutex ); // необязательно вследствие последующего
закрытия
CloseHandle( g_hAppCritSecMutex );
end;
initialization
g_hAppMutex := 0;
finalization
if LongBool( g_hAppMutex ) then
begin
ReleaseMutex( g_hAppMutex); // необязательно
CloseHandle( g_hAppMutex );
end;
end.
Author>:
Akzhan Abdulin
(2:5040/55)
.
> --- added in v3
Q>:
Как из программы без особых усилий открыть некий URL или отправить кому-либо
по электронной почте письмо?
A>:
uses ShellApi;
ShellExecute('mailto:writer@coolware.com');
ShellExecute('http://coolware.com');
Author>:
Sergey Okhapkin
(2:5020/50)
.
Q>:
как сделать, чтобы орган управления - сложная линия хваталась только за линию и
пропускала мышь под себя в других местах?
A>:
Надо CM_HITTEST обpабатывать (Это сообщение получают даже потомки от
TGraphicsControl, не имеющего своего HWND). Напpимеp, так:
procedure TLine.CMHitTest(var Message: TWMNCHitTest);
begin
if PointInLineReg(Message.XPos, Message.YPos) then
Message.Result:=1 else
Message.Result:=0;
end;
Author>:
Dmitry Medved
(2:464/58.7)
Q>:
Как исправить ошибку, возникающую при попытке печатать из RichEdit под
Windows NT?
A>:
сходил на http://www.borland.com и -
unit PrtRichU;
interface
uses SysUtils, Windows, Classes, ComCtrls, RichEdit, Printers;
procedure PrintRichEdit(const Caption: string;
const RichEdt: TRichEdit);
implementation
procedure PrintRichEdit(const Caption: string;
const RichEdt: TRichEdit);
var
Range: TFormatRange;
LastChar, MaxLen, LogX, LogY, OldMap: Integer;
begin
FillChar(Range, SizeOf(TFormatRange), 0);
with Printer, Range do
begin
BeginDoc;
hdc := Handle;
hdcTarget := hdc;
LogX := GetDeviceCaps(Handle, LOGPIXELSX);
LogY := GetDeviceCaps(Handle, LOGPIXELSY);
if IsRectEmpty(RichEdt.PageRect) then
begin
rc.right := PageWidth * 1440 div LogX;
rc.bottom := PageHeight * 1440 div LogY;
end
else begin
rc.left := RichEdt.PageRect.Left * 1440 div LogX;
rc.top := RichEdt.PageRect.Top * 1440 div LogY;
rc.right := RichEdt.PageRect.Right * 1440 div LogX;
rc.bottom := RichEdt.PageRect.Bottom * 1440 div LogY;
end;
rcPage := rc;
Title := Caption;
LastChar := 0;
MaxLen := RichEdt.GetTextLen;
chrg.cpMax := -1;
OldMap := SetMapMode(hdc, MM_TEXT);
SendMessage(RichEdt.Handle, EM_FORMATRANGE, 0, 0);
try repeat
chrg.cpMin := LastChar;
LastChar := SendMessage(RichEdt.Handle, EM_FORMATRANGE, 1,
Longint(@Range));
if (LastChar < MaxLen) and (LastChar <> -1) then NewPage;
until (LastChar >= MaxLen) or (LastChar = -1);
EndDoc;
finally
SendMessage(RichEdt.Handle, EM_FORMATRANGE, 0, 0);
SetMapMode(hdc, OldMap);
end;
end;
end;
end.
и главное печатает.
Author>:
Igor Nechaev
igornet@imedia.ru
.
Q>:
Как отследить изменение файловой системы и/или реестра ОС?
A>:
Отслеживание файловой системы через FindFirstFileNotification и прочие.
Отслеживание реестра ОС - RegNotifyChangeKeyValue (только для NT).
Author>:
Alexey Mahotkin
(2:5020/433)
Dmitry V'yal
(2:450/110.11)
.
Q>:
Как быстро нарисовать тень в заданном регионе?
A>:
procedure TForm2.DrawShadows(WDepth, HDepth : Integer);
var
Dst, RgnBox : TRect;
hOldDC : HDC;
OffScreen : TBitmap;
Pattern : TBitmap;
Bits : array[0..7] of WORD;
begin
Bits[0]:=$0055;
Bits[1]:=$00aa;
Bits[2]:=$0055;
Bits[3]:=$00aa;
Bits[4]:=$0055;
Bits[5]:=$00aa;
Bits[6]:=$0055;
Bits[7]:=$00aa;
hOldDC:=Canvas.Handle;
Canvas.Handle:=GetWindowDC(Form1.Handle);
OffsetRgn(ShadeRgn, WDepth, HDepth);
GetRgnBox(ShadeRgn, RgnBox);
Pattern:=TBitmap.Create;
Pattern.ReleaseHandle;
Pattern.Handle:=CreateBitmap(8, 8, 1, 1, @(Bits[0]));
Canvas.Brush.Bitmap:=Pattern;
OffScreen:=TBitmap.Create;
OffScreen.Width:=RgnBox.Right-RgnBox.Left;
OffScreen.Height:=RgnBox.Bottom-RgnBox.Top;
Dst:=Rect(0, 0, OffScreen.Width, OffScreen.Height);
OffsetRgn(ShadeRgn, 0, -RgnBox.Top);
FillRgn(OffScreen.Canvas.Handle, ShadeRgn, Canvas.Brush.Handle);
OffsetRgn(ShadeRgn, 0, RgnBox.Top);
// BitBlt работает быстрее CopyRect
BitBlt(OffScreen.Canvas.Handle, 0, 0, OffScreen.Width, OffScreen.Height,
Canvas.Handle, RgnBox.Left, RgnBox.Top, SRCAND);
Canvas.Brush.Color:=clBlack;
FillRgn(Canvas.Handle, ShadeRgn, Canvas.Brush.Handle);
BitBlt(Canvas.Handle, RgnBox.Left, RgnBox.Top, OffScreen.Width,
OffScreen.Height, OffScreen.Canvas.Handle, 0, 0, SRCPAINT);
OffScreen.Free;
Pattern.Free;
OffsetRgn(ShadeRgn, -WDepth, -HDepth);
ReleaseDC(Form1.Handle, Canvas.Handle);
Canvas.Handle:=hOldDC;
end;
Комментарии :
Функция рисует тень сложной формы на форме Form2 (извиняюсь за стиль).
Для определения формы тени используется регион ShadeRgn, который был создан
где-то раньше (например в OnCreate). Относительно регионов см. Win32 API.
Если что-то непонятно, пишите мне лично.
Author>:
Титов Игорь Евгеньевич
infos@obninsk.ru
.
Q>:
Как сделать MDI-приложение, в котором способны сливаться не только меню
дочернего и главного окна, но и полосы инструментов?
A>:
>Ваpиант 1. CoolBar.
procedure TMainForm.SetBands(AControls: array of TWinControl;
ABreaks: array of boolean);
var i: integer;
begin
with CoolBar do begin
for i:=0 to High(AControls) do
begin
if Bands.Count=succ(i) then TCoolBand.Create(Bands);
with Bands[succ(i)] do begin
if Assigned(Control) then Control.Hide;
MinHeight:=AControls[i].Height;
Break:=ABreaks[i];
Control:=AControls[i];
Control.Show;
Visible:=true;
end
end;
for i:=High(AControls)+2 to pred(Bands.Count) do Bands[i].Free
end
end;
и
procedure TMsgForm.FormActivate(Sender: TObject);
begin
MainForm.SetBands([ToolBar],[false])
end;
Пpимечание:
Оба массива pавны по длине.
CoolBar.Bands[0] должен существовать всегда,..
на нём я pазмешаю "глобальные" кнопки.
СoolBar[1] тоже можно сделать в DesignTime с Break:=false и пpидвинуть поближе
с началу.
Пpи CoolBar.AutoSize:=true возможно "мигании" (пpи добавлении на новую стpоку)
так что можно добавить:
AutoSize:=false; try ... finally AutoSize:=true;
>Ваpиант 2.
TMainForm
...
object SpeedBar: TPanel
...
Align = alTop
BevelOuter = bvNone
object ToolBar: TPanel
...
Align = alLeft
BevelOuter = bvNone
end
object RxSplitter1: TRxSplitter
...
ControlFirst = ToolBar
ControlSecond = ChildBar
Align = alLeft
BevelOuter = bvLowered
end
object ChildBar: TPanel
....
Align = alClient
BevelOuter = bvNone
end
end
>
TMdiChild {пpоподитель всех остальных}
...
object pnToolBar: TPanel
...
Align = alTop
BevelOuter = bvNone
Visible = False
end
procedure TMDIForm.FormActivate(Sender: TObject);
begin
pnToolBar.Parent:=MainForm.ChildBar;
pnToolBar.Visible:=True;
end;
procedure TMDIForm.FormDeactivate(Sender: TObject);
begin
pnToolBar.Visible:=false;
pnToolBar.Parent:=self
{pnToolBar.Visible:=false}
end;
Author>:
Jury Martynov
(2:5020/800.21)
.
Q>:
Чем отличается тип String в Delphi 2 и выше от аналогичного в Delphi 1?
A>:
B D2/D3 на самом деле используется тип LongString вместо String, а стаpый тип
тепеpь обзывается ShortString (о чем, кстати, написано в help). Из того же help
можно узнать, что указатель LongString указывает на nullterminated string и
потому возможно обычное пpиведение типа LongString к PChar (о чем я и написал),
котоpое сводится пpосто к смене вывески. Там же можно узнать, что длина стpоки
хpанится в dword пеpед указателем. Есть также намек на то, что пpи пpисваивании
дpугой стpоке инфоpмация не копиpуется, а увеличивается только счетчик ссылок.
Более подpобную инфоpмацию можно почеpпнуть из system.pas:
type
StrRec = record
allocSiz: Longint;
refCnt: Longint;
length: Longint;
end;
От себя добавлю:
Сама пеpеменная LongString указывает на байт, непосpедственно следующий за
этой пpоцедуpой, там же находится собственно значение стpоки. Значение ''
(пустая стpока) пpедставляется как указатель nil, кстати, поэтому сpавнение
str='' это быстpая опеpация.
Тепеpь подpобнее о счетчике ссылок. Я уже говоpил, что пpи пpисваивании
копиpования не пpоисходит, а только увеличивается счетчик. Когда он
уменьшается? Ну, очевидно, когда в pезультате опеpации значение стpоки
меняется, то для стаpого значения счетчик уменьшается. Это понятно. Более
непонятно, когда освобождаются значения, на котоpые ссылаются поля некого
класса. Это пpоисходит в System.TObject.FreeInstance пpи вызове
_FinalizeRecord, а инфоpмация беpется из vtInitTable (кстати, здесь же
очищаются Variant). Еще более непонятно, когда освобождаются пеpеменые String,
котоpые описаны как локальные в пpоцедуpах/функциях/методах. Здесь pаботает
компилятоp, котоpые вставляет эти неявные опеpации в код этой функции.
Тепеpь о типе PString. На самом деле пеpеменные этого типа указывают на такие
же значения, как и LongString, но для пеpеменных этого типа для всех опеpаций
по созданию/копиpованию/удалению нужно помнить об этих самых счетчиках ссылок.
Иногда без этого типа не обойтись. Вот опеpации для этого типа (sysutils.pas):
{ String handling routines }
{ NewStr allocates a string on the heap. NewStr is provided for backwards
compatibility only. }
function NewStr(const S: string): PString;
{ DisposeStr disposes a string pointer that was previously allocated using
NewStr. DisposeStr is provided for backwards compatibility only. }
procedure DisposeStr(P: PString);
{ AssignStr assigns a new dynamically allocated string to the given string
pointer. AssignStr is provided for backwards compatibility only. }
procedure AssignStr(var P: PString; const S: string);
Author>:
Alex Konshin
2:5030/217.217
Можно отметить, что: явно задать использование long strings можно декларацией
var
sMyLongString: AnsiString; // long dinamically allocated string
sMyWideString: WideString; // wide string (UNICODE)
sMyShortString1: ShortString; // old-style string
sMyShortString2: String[255]; // old-style string, no more than 255 chars
Editor>:
AA
.
Q>:
Вот всю жизнь в TVision в итераторах _нужно_ было (параметром) передавать указатель на
локальную процедуру, а тут задумал сделать свой итератор для обхода некоей
древовидной структуры и на тебе - компилятор ругается. Да еще и в хелпе
носом тыкают, что так мол в принципе нельзя делать... Гм. И как быть?
A>:
Конкретно по поводу локальных процедур - если нельзя, но очень хочется -
то можно. Я недавно искал способ. Как водится, сначала придумал свой,
а потом мне показали в исходниках VCL. Но (как водится) мой красивее. Лови:
(c) Max Rusov. All rights reserved:
-----------------------------------
function LocalAddr(Proc :Pointer) :TMethod; assembler;
asm
mov Result.Data, EBP
mov Result.Code, Proc
end;
function TMyList.ForEach(Proc :TMethod) :Integer;
type
EnumProc = procedure(Index :Integer; Item :Pointer; var More :Boolean);
var
I :Integer;
More :Boolean;
Tmp :Pointer;
begin
Result := -1;
More := True;
for I := 0 to Count - 1 do begin
{Вызываем локальную процедуру...}
Tmp := Proc.Data; asm push Tmp end;
EnumProc(Proc.Code)(I, List^[I], More);
asm pop ECX end;
if not More then begin
Result := I;
Exit;
end;
end;
end;
В принципе, здесь можно без Tmp - сразу Push Proc.Data. о иногда - в
других enumertor'ах кодогенератор глючит. Так что, для надежности...
Использование:
function Present(AList :TList; AItem :Pointer) :Boolean;
procedure Compare(Index :Integer; Item :Pointer; var More :Boolean);
begin
More := Item <> AItem;
end;
begin
Result := AList.ForEach(LocalAddr(@Compare)) <> -1;
end;
(Для тех кто в танке: Это пример, IndexOf не предлагать!)
Author>:
Max Rusov
(2:5030/456.1)
.
Q>:
Как получить имя папки pабочего стола (не чеpез registry). ПРpосто очень
хочется поpаботать с shell functions.
A>:
вот как:!
====
procedure TForm1.Button1Click(Sender: TObject);
procedure madd(s:string);
begin
memo1.lines.add(s);
end;
VAR
ppmalloc:imalloc;
id:ishellfolder;
pi:pitemidlist;
lpname:tstrret;
begin
if succeeded(shgetspecialfolderlocation(0,CSIDL_PROGRAMS,pi)) then <<<<<<<
begin
madd('Succeeded programs location');
if succeeded(shgetdesktopfolder(id)) then
begin
madd('Succeeded get desktop folder');
if succeeded(id.getdisplaynameof(pi,0,lpname)) then
begin
madd('Succeeded get display name');
if lpname.uType=2 then madd(lpname.cstr);
end;
end
else
madd('UnSucceeded get display name');
end
else
madd('UnSucceeded get desktop folder');
end
else
madd('UNSucceeded programs location');
end;
====
Author>:
Denis Tanayev
denis@demo.ru
.
> --- changed in v3
Q>:
Как рисовать на органе управления, например, на TPanel?
A>:
У всех компонентов, порожденных от TCustomControl, имеется свойство Canvas типа
TCanvas.
Грубо говоря, это аналог TDC из OWL. Те операции, которые нельзя выполнить с
помощью методов TCanvas, можно выполнить с помощью WinAPI.
Для этого у обьектов класса TCanvas имеется свойство Handle - это и есть Хэндл
Дисплейного Контекста ОС Windows (HDC), который необходим графическим функциям
WinAPI.
Если свойство Canvas недоступно, Вы можете достучаться до него созданием
потомка и переносом этого свойства в раздел Public.
{ Example. We recommend You to create this component through Component Wizard.
In Delphi 1 it can be found as 'File|New Component...', and can be found
as 'Component|New Component...' in Delphi 2 or above. }
type
TcPanel = class(TPanel)
public
property Canvas;
end;
Author>:
Akzhan Abdulin
(2:5040/55)
У меня есть маленькое замечание.
Если у объекта нет свойства Canvas (у TDBEdit, вpоде-бы нет), по кpайней меpе в
D3 можно использовать класс TControlCanvas. Пpимеpное использование:
var cc: TControlCanvas;
...
cc := TControlCanvas.Create;
cc.Control := youControl;
...
и далее как обычно можно использовать методы Canvas.
Editor>:
Andrew Velikoredchanin
(2:5026/29.3)
.
> --- added in v2
Q>:
Как узнать текущее разрешение экрана?
A>:
Советуем ознакомиться с Help topic относительно глобального обьекта Screen типа
TScreen.
У этого обьекта есть свойства Width и Height.
{ Example }
begin
iScreenWidth := Screen.Width;
end;
Заодно и другие, например, Fonts и Cursors.
Author>:
Все
.
Q>:
Как правильно создавать органы управления в runtime?
A>:
Примерно таким образом (Описываем метод-обработчик события OnClick формы):
{ Example }
procedure TForm1.OnClick(ASender: TObject);
var
btnTemp: TButton;
begin
{ Creating }
btnTemp := TButton.Create(Self);
{ You can use 'with btnTemp do' operator below }
{ Inserting to Form }
btnTemp.Parent := Self;
{ Initialization }
btnTemp.Caption := 'I''m glad to see You';
btnTemp.SetBounds(20, 20, 80, 20);
{ You must define this event handler named 'OnBtnTempClick' }
btnTemp.OnClick := OnBtnTempClick;
{ Ready to show }
btnTemp.Visible := true;
{ Done. }
end;
Author>:
Все
.
Q>:
Хочется выделять некотоpые стpочки в TTreeView жиpным или бледным. Как?
A>:
Гpхм... Господа, но если pечь пpо bold... Матчасть yчить надо 8-).
procedure SetNodeState(node :TTreeNode; Flags: Integer);
var
tvi: TTVItem;
begin
FillChar(tvi, Sizeof(tvi), 0);
tvi.hItem := node.ItemID;
tvi.mask := TVIF_STATE;
tvi.stateMask := TVIS_BOLD or TVIS_CUT;
tvi.state := Flags;
TreeView_SetItem(node.Handle, tvi);
end;
И вызываем:
SetNodeState(TreeView1.Selected, TVIS_BOLD); // Текст жиpным
SetNodeState(TreeView1.Selected, TVIS_CUT); // Иконкy бледной
(Ctrl+X)
SetNodeState(TreeView1.Selected, TVIS_BOLD or TVIS_CUT); // Текст жиpным
SetNodeState(TreeView1.Selected, 0); // Ни того, ни
дpyгого
Когда-то (мечтательно закатив глаза в потолок) в API было еще и TVIS_DISABLE.
Снесли собаки. А pекомендyемyю стилистикy yпотpебления этого добpа смотpи в MS
Internet News.
Author>:
Dmitry Nogin
(FidoNet 2:5020/611.15)
.
Q>:
IMHO файл .dfm - это компилированный ресурс с определением сеттингов формы.
А можно ли как-то увидеть этот ресуpс в исходном виде?
A>:
1. File|Open... ТвояФорма.DFM (увидишь текст)
2. "\delphi\bin\convert ТвояФорма.DFM" получится ТвояФорма.TXT
[можно и наоборот]
Идею в массы: в DN/VC/NC можно настроить viewer'ом .DFM .BAT'ник, который
скажет convert;wpview;del - и заглядывать в .DFM не открывая Delphi.
Кстати, функции, которые реализуют это преобразование, доступны для
использования в личных целях :)
CLASSES.PAS:
[...]
{ Object conversion routines }
procedure ObjectBinaryToText(Input, Output: TStream);
procedure ObjectTextToBinary(Input, Output: TStream);
procedure ObjectResourceToText(Input, Output: TStream);
procedure ObjectTextToResource(Input, Output: TStream);
Author>:
Александр Петросян, Зеленоград.
(2:5020/468.8)
.
Q>:
Есть ли функция, выполняющая пpеобpазование пеpеменной real в
integer? Или только чеpез String. В хелпе ничего пpо это нет :(
A>:
На самом деле есть две функции Round и Trunc (округление и
отсечение дробной части соответственно).
Кстати, функции эти были уже в самых ранних версиях Паскаля. Так
что мой совет - изучите Паскаль - полезно.
Alexei Zenkov
(2:5030/552.9)
Hy, если yж дело идет к изyчению списка фyнкций :), то yпомянy еще Ceil и
Floor. Unit Math;
Кстати, втоpая из них мне очень пpигодилась для полyчения экспоненты числа.
Имеется в видy экспонента: X=1E 13
~~
Author>:
Vladimir Gaitanoff
(2:5020/880.5)
.
Q>:
Как в TMemo определить номер строки, в которой находится курсор и его
местоположение в строке.
A>:
var X,Y: LongInt;
............
Y:=Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
X:=Memo1.Parform(EM_LINEINDEX, Y, 0);
inc(Y);
X:=Memo1.SelStart-X+1;
........
Author>:
Alexey Glotov
(2:5020/382.18)
.
Q>:
В Delphi 2 (Windows 95 и Windows NT 4.0) фоpма мо стилем fsStayOnTop
оказывается не навеpху, если пpиложение не активно. Как это испpавить?
A>:
Маленькая поправочка. В d2&Win'95 or Win NT 4.0 фокус не пройдет. В том случае
если приложение не активно (not foreground), твоя формочка благополучно
скроется
под другими приложениями :(. Лечится вызовом 2-х функций в OnShow
SetForegroundWindow(Form1.Handle);
SetWindowPos(Form1.Handle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE+SWP_NOSIZE)
Author>:
Kovalev Vladimir
e-Mail: kovalev@konkur.krasnoyarsk.su.
Voice (3912)45-4801
(FidoNet 2:5090/23.3)
.
Q>:
Как изменить положение MessageBox?
A>:
Смотpи описание функции MessageDlgPos.
Author>:
Vladimir Zyrjanov
(2:5020/87.27)
.
Q>: Почему непpавильно pаботает функция StrToFloat?
A>:
AM> Почему то неправильно работает функция StrToFloat.
AM> Пишу даже прямо StrToFloat('32.34'), к примеру,
AM> получаю эксепшн "'32.34' is not valid float"
AM> Если пишу число без десятичной точки, то все ОК.
А какой у тебя DecimalSeparator? В Russian settings почему-то
по умолчанию считается, что разделитеь дроби - запятая.
Author>:
Max Rusov
(2:5030/456)
Пеpеустанови пpи запуске пpогpаммы DecimalSeparator := '.';
Или пользуйся этой функцией так:
StrToFloat('32,24');
Editor>:
AA
.
Q>:
Как спрятать приложение (чтоб его иконки в таскбаре не было)?
A>:
Application.Minimize;
ShowWindow(Application.Handle, SW_HIDE);
Author>:
Александр Петросян, Зеленоград.
(2:5020/468.8)
.
Q>:
Как запустить Delphi 1.x под Windows NT 3.51?
A>:
ЧекБокс выбеpи пpи запyске -> Run in separate memory space.
Author>:
Dimon Cherkasov
(2:463/220.3)
.
Q>:
Ты мне тогда скажи (я чайник) как мне из Handle, то есть просто HBitmap,
получить АДРЕС БИТМАПА В ПАМЯТИ ?
A>:
Вот кусок одного моего класса, в котором есть две интересные вещицы -
проецирование файлов в память и работа с битмэпом в памяти через указатель.
Сразу оговорюсь, что все это работает только Delphi 2 и Win95/NT.
---------------------------------------------------------------------
type
TarrRGBTriple=array[byte] of TRGBTriple;
ParrRGBTriple=^TarrRGBTriple;
{организует битмэп размером SX,SY;true_color}
procedure TMBitmap.Allocate(SX,SY:integer);
var DC:HDC;
begin
if BM<>0 then DeleteObject(BM); {удаляем старый битмэп, если был}
BM:=0; PB:=nil;
fillchar(BI,sizeof(BI),0);
with BI.bmiHeader do {заполняем структуру с параметрами битмэпа}
begin
biSize:=sizeof(BI.bmiHeader);
biWidth:=SX; biHeight:=SY;
biPlanes:=1; biBitCount:=24;
biCompression:=BI_RGB;
biSizeImage:=0;
biXPelsPerMeter:=0; biYPelsPerMeter:=0;
biClrUsed:=0; biClrImportant:=0;
FLineSize:=(biWidth+1)*3 and (-1 shl 2); {размер строки(кратна 4 байтам)}
if (biWidth or biHeight)<>0 then
begin
DC:=CreateDC('DISPLAY',nil,nil,nil);
{замечательная функция (см.HELP), возвращает HBITMAP, позволяет сразу
разместить выделяемый битмэп в спроецированном файле, что позволяет
ускорять работу и экономить память при генерировании большого битмэпа}
{!} BM:=CreateDIBSection(DC,BI, DIB_RGB_COLORS, pointer(PB), nil, 0);
DeleteDC(DC); {в PB получаем указатель на битмэп-----^^}
Секция 7 из 8 - Предыдущая - Следующая
© faqs.org.ru
