faqs.org.ru

 Главная > Программирование > Языки Pascal/Delphi >

FAQ по работе с Windows API и Delphi VCL

Секция 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 - Предыдущая - Следующая

Macbook Air 11 в Казахстане
Macbook Air 11 в Казахстане
apples.kz

Вернуться в раздел "Языки Pascal/Delphi" - Обсудить эту статью на Форуме
Главная - Поиск по сайту - О проекте - Форум - Обратная связь

© faqs.org.ru