Еще слать?

Огромное спасибо. Шли конечно...

Как получить доступ к битам переменной и управлять их значением?

Решение 1

Код

unit Bitwise; interface function IsBitSet(const val: longint; const TheBit: byte): boolean; function BitOn(const val: longint; const TheBit: byte): LongInt; function BitOff(const val: longint; const TheBit: byte): LongInt; function BitToggle(const val: longint; const TheBit: byte): LongInt; implementation function IsBitSet(const val: longint; const TheBit: byte): boolean; begin  result := (val and (1 shl TheBit)) <> 0; end; function BitOn(const val: longint; const TheBit: byte): LongInt; begin  result := val or (1 shl TheBit); end; function BitOff(const val: longint; const TheBit: byte): LongInt; begin  result := val and ((1 shl TheBit) xor $FFFFFFFF); end; function BitToggle(const val: longint; const TheBit: byte): LongInt; begin  result := val xor (1 shl TheBit); end; end.

Решение 2
SetWord – слово, которое необходимо установить.
BitNum – номер бита, который необходимо выставить согласно определениям в секции const (Bit0, Bit1 и др.).
GetBitStat возвращает значение True, если бит установлен и False – в противном случае.

Код

const  Bit0 = 1;  Bit1 = 2;  Bit2 = 4;  Bit3 = 8;  Bit4 = 16;  Bit5 = 32;  Bit6 = 64;  Bit7 = 128;  Bit8 = 256;  Bit9 = 512;  Bit10 = 1024;  Bit11 = 2048;  Bit12 = 4096;  Bit13 = 8192;  Bit14 = 16384;  Bit15 = 32768; procedure SetBit(SetWord, BitNum: Word); begin  SetWord := SetWord Or BitNum;        { Устанавливаем бит } end; procedure ClearBit(SetWord, BitNum: Word); begin  SetWord := SetWord Or BitNum;       { Устанавливаем бит }  SetWord := SetWord Xor BitNum;      { Переключаем бит } end; procedure ToggleBit(SetWord, BitNum: Word); begin  SetWord := SetWord Xor BitNum;      { Переключаем бит } end; function GetBitStat(SetWord, BitNum: Word): Boolean; begin  GetBitStat := SetWord and BitNum = BitNum; { Если бит установлен } end;

Источник: Книга В. Озерова "Delphi. Советы программистов"

----------------------------------------------------------------------------------------------------
Пожелание
Добавить ссылку на статью "VCL/TForm/Общие вопросы/Как иммитировать появление формы как нового приложения?" В раздел "Системные функции и WinAPI/Windows/Taskbar, кнопка Пуск..."

Это сообщение отредактировал(а) StayAtHome - 1.2.2004, 03:37

Как послать самостийное сообщение всем окнам Windows?

Код

Var FM_FINDPHOTO: Integer; // Для использовать hwnd_Broadcast нужно сперва // зарегистрировать уникальное сообщение Initialization FM_FindPhoto:=RegisterWindowMessage('MyMessageToAll'); // Чтобы поймать это сообщение в другом приложении //(приемнике) нужно перекрыть DefaultHandler procedure TForm1.DefaultHandler(var Message); begin  with TMessage(Message) do  begin    if Msg = Fm_FindPhoto then MyHandler(WPARAM,LPARAM)  else    Inherited DefaultHandler(Message);  end; end; // А тепрь можно SendMessage(HWND_BROADCAST,FM_FINDPHOTO,0,0);

Кстати, для посылки сообщения дочерним контролам некоего контрола можно использовать метод Broadcast.

АвторAndrey Burov
(2:463/238.19)

Как отчитывать промежутки времени с точностью, большей чем 60 мсек?
Для начала описываешь процедуру, которая будет вызываться по сообщению от таймера :

Код

procedure FNTimeCallBack(uTimerID, uMessage: UINT;dwUser, dw1, dw2: DWORD) stdcall; begin // //  Тело процедуры. end;

а дальше в программе (например по нажатию кнопки) создаешь Таймер и вешаешь на него созданную процедуру

Код

uTimerID:=timeSetEvent(10,500,@FNTimeCallBack,100,TIME_PERIODIC);

Подробности смотри в Help.
Hу и в конце убиваешь таймер

Код

timeKillEvent(uTimerID);

И все. Точность этого способа до 1 мсек. минимальный интервал времени можно задавать 1 мсек.

Автор: Leonid Tserling
[email protected]

Как указать максимальный размер текста для RichEdit Control?
У этого компонента есть свойство MaxLength, которое работает некорректно. Поэтому лучше пользоваться

Код

RichEdit.Perform(EM_LIMITTEXT, нужный размер, 0);

Причем перед каждом открытии файла это действие необходимо повторять.

Maxim Liverovskiy
(2:5030/254.38)

Если Вы передаете в качестве размера 0, то ОС ограничивает размер OS Specific Default Value. Реально, по результатам моих экспериментов, поставить можно размер, чуть меньший доступной виртуальной памяти. Я ограничился 90% от свободной виртуалки.
Для того, чтобы не повторять этот вызов (EM_LIMITTEXT), можно воспользоваться сообщением EM_EXLIMITTEXT.

Stas Mehanoshin
(2:5030/143.23)

Как рисовать картинки в пунктах меню?

Код

unit DN_Win; interface uses  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,  Forms, Dialogs, Menus, StdCtrls, type  TDNForm = class(TForm)    MainMenu1: TMainMenu;    cm_MainExit: TMenuItem;    procedure FormCreate(Sender: TObject);    procedure cm_MainExitClick(Sender: TObject);  private    { Private declarations }  public    { Public declarations }    BM:TBitmap;    Procedure WMDrawItem(var Msg:TWMDrawItem);      message wm_DrawItem;    Procedure WMMeasureItem(var Msg:TWMMeasureItem); message wm_MeasureItem;  end; var  DNForm : TDNForm; implementation {$R *.DFM} var  Comm,yMenu : word; procedure TDNForm.FormCreate(Sender: TObject); begin  {?? ? ¦}  yMenu:=GetSystemMetrics(SM_CYMENU);  comm:=cm_MainExit.Command;  ModifyMenu(MainMenu1.Handle,0,mf_ByPosition or mf_OwnerDraw,comm,'Go'); end;{TDNForm.FormCreate} procedure TDNForm.cm_MainExitClick(Sender: TObject); begin  DNForm.Close; end;{TDNForm.cmExitClick} {?? ? ¦} Procedure TDNForm.WMMeasureItem(var Msg:TWMMeasureItem); Begin with Msg.MeasureItemStruct^ do  if ItemID=comm then  begin ItemWidth:=yMenu; Itemheight:=yMenu; end; End;{WMMeasureItem} {} Procedure TDNForm.WMDrawItem(var Msg:TWMDrawItem); var  MemDC:hDC;  BM:hBitMap;  mtd:longint; Begin with Msg.DrawItemStruct^ do  begin  if ItemID=comm then    begin      BM:=LoadBitMap(hInstance,'dver');      MemDC:=CreateCompatibleDC(hDC);{hDC ? TDrawItemStruct}      SelectObject(MemDC,BM);      {rcItem ? TDrawItemStruct}      if ItemState=ods_Selected then mtd:=NotSrcCopy  else mtd:=SrcCopy; StretchBlt(hDC,rcItem.left,rcItem.top,yMenu,yMenu,MemDC,0,0,24,23,mtd);      DeleteDC(MemDC);      DeleteObject(BM);    end;  end{with} End;{TDNForm.WMDrawItem} end.

Eugeny Sverchkov
[email protected]
(2:5031/12.23)
-----------------------------------------------------------------------------------------------------------
К сожалению, до меня этот совет дошел уже с битой кодировуой в комментариях

Это сообщение отредактировал(а) StayAtHome - 1.2.2004, 14:09

Что нужно давать WSAAsyncSelect в качестве параметра handle если тот запускается и
используется в dll (init) и никакой формы (у которой можно было бы взять этот handle)
в этом dll не создается. Что бы такого сделать чтобы работало?

Код

const  WM_ASYNCSELECT = WM_USER+0; type  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;

Hо 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омче.

Автор: Alex Konshin
[email protected]
(2:5030/217)

Как правильно в Win32 отслеживать запуск второй копии программы?
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.

Автор:Akzhan Abdulin
(2:5040/55)

Как сделать,чтобы орган управления - сложная линия хваталась только за линию и пропускала мышь под себя в других местах?
Надо CM_HITTEST обpабатывать (Это сообщение получают даже потомки от TGraphicsControl, не имеющего своего HWND). Hапpимеp, так:

Код

procedure TLine.CMHitTest(var Message: TWMNCHitTest); begin  if PointInLineReg(Message.XPos, Message.YPos) then    Message.Result:=1  else    Message.Result:=0; end;

Автор:Dmitry Medved
(2:464/58.7)
-------------------------------------------------------------------------------
Как отследить изменение файловой системы и/или реестра ОС?
Отслеживание файловой системы через FindFirstFileNotification и прочие.
Отслеживание реестра ОС - RegNotifyChangeKeyValue (только для NT).

Авторы:Alexey Mahotkin(2:5020/433)
Dmitry V'yal(2:450/110.11)


Примечание:Вопрос об отслеживании файлов уже есть, а вот о реестре - я не нашел.
-------------------------------------------------------------------------------
Как получить имя папки pабочего стола (не чеpез registry). ПРpосто очень
хочется поpаботать с shell functions.

Код

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      else        madd('UnSucceeded get display name');      end    else      madd('UnSucceeded get desktop folder');    end  else    madd('UNSucceeded programs location'); end;

Автор: Denis Tanayev
[email protected]

Как рисовать на органе управления, например, на TPanel (у которого нет свойства Canvas)?
У всех компонентов, порожденных от 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;

Автор:Akzhan Abdulin
(2:5040/55)

У меня есть маленькое замечание.
Если у объекта нет свойства Canvas (у TDBEdit, вpоде-бы нет), по кpайней меpе в D3 можно использовать класс TControlCanvas. Пpимеpное использование:

Код

var cc: TControlCanvas; ... cc := TControlCanvas.Create; cc.Control := youControl; ...

и далее как обычно можно использовать методы Canvas.

Автор:Andrew Velikoredchanin
(2:5026/29.3)
-------------------------------------------------------------------------------
Как выделить некотоpые стpочки в TTreeView жиpным или бледным?
Г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);                       // Hи того, ни дpyгого

Когда-то (мечтательно закатив глаза в потолок) в API было еще и TVIS_DISABLE.Снесли собаки. А pекомендyемyю стилистикy yпотpебления этого добpа смотpи в MS Internet News.

Автор:Dmitry Nogin
(FidoNet 2:5020/611.15)

IMHO файл .dfm - это компилированный ресурс с определением сеттингов формы.А можно ли как-то увидеть этот ресуpс в исходном виде?
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);

Автор:Александр Петросян, Зеленоград.
(2:5020/468.8)
-------------------------------------------------------------------------------
Как в TMemo определить номер строки, в которой находится курсор и его местоположение в строке.

Код

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;

Автор:Alexey Glotov(2:5020/382.18)
-------------------------------------------------------------------------------
Можно ли запустить OpenGL под Windows'95, и как поставлять его с программой?
Беpешь, к пpимеpy, из диcтpибyтива OSR2 GLU32.DLL и OPENGL32.DLL - и запycкай на здоpовье.

Автор:Alexei Ivanov(2:5020/942.1)

Более эффективную реализацию OpenGL для Win32 от фирмы SGI я бы советовал стянуть с www.sgi.com или www.opengl.org

Автор:Akzhan Abdulin(2:5040/55)
-------------------------------------------------------------------------------
Как создать клон (копию, достаточно близкую к оригиналу) произвольного компонента?
Здесь пpоцедypа CreateClone, котоpая кpеатит компонентy ОЧЕHЬ ПОХОЖУЮ на
входнyю. С такими же значениями свойств. Пpисваивается все, кpоме методов.

Код

function CreateClone(Src: TComponent): TComponent; var  F: TStream; begin  F := nil;  try    F := TMemoryStream.Create;    F.WriteComponent(Src);    RegisterClass(TComponentClass(Src.ClassType));    F.Position := 0;    Result := F.ReadComponent(nil);  finally    F.Free;  end; end;

Автор:Vladimir Gaitanoff(2:5020/880.5)

Как задать в качестве фона MDIForm картинку из TBitmap?

Код

interface  type ....  =class(TForm)  ....  procedure FormCreate(Sender:TObject);  procedure FormDestroy(Sender:TObject);  ....  private    FHBrush:HBRUSH;    FCover:TBitmap;    FNewClientInstance:TFarProc;    FOldClientInstance:TFarProc;  procedure NewClientWndProc(var Message:TMessage);  ....  protected  ....  procedure CreateWnd;override;  ....  end;  ..... implementation {$R myRes.res} //pесуpс с битмапом фона procedure .FormCreate(...); var  LogBrush:TLogbrush; begin  FCover:=TBitmap.Create;  FCover.LoadFromResourceName(hinstance,'BMPCOVER');  With LogBrush do  begin    lbStyle:=BS_PATTERN;    lbHatch:=FCover.Handle;  end;  FHBrush:=CreateBrushIndirect(Logbrush); end; procedure .FormDestroy(...); begin  DeleteObject(FHBrush);  FCover.Free; end; procedure .CreateWnd; begin  inherited CreateWnd;  if (ClientHandle <> 0) then    begin    if  NewStyleControls then        SetWindowLong(ClientHandle, GWL_EXSTYLE, WS_EX_CLIENTEDGE or          GetWindowLong(ClientHandle, GWL_EXSTYLE));    FNewClientInstance:=MakeObjectInstance(NewClientWndProc);    FOldClientInstance:=pointer(GetWindowLong(ClientHandle,GWL_WNDPROC));    SetWindowLong(ClientHandle,GWL_WNDPROC,longint(FNewClientInstance));    end; end; procedure .NewClientWndProc(var Message:TMessage);  procedure Default;  begin    with Message do      Result := CallWindowProc(FOldClientInstance, ClientHandle, Msg, wParam, lParam);  end; begin  with Message do    case Msg of    WM_ERASEBKGND:      begin      FillRect(TWMEraseBkGnd(Message).DC, ClientRect,FHBrush);      Result := 1;      end;    else      Default;    end; end;

Автор:Alex Miachin(2:5000/81.12)

-------------------------------------------------------------------------------
Как корректно перехватить сигнал выгрузки операционной системы, если в моей программе нет окна?
Используй GetMessage(), в качестве HWND окна пиши NULL. Если в очереде сообщений следущее WM_QUIT, то функция фозвращает FALSE.
Если ты пишешь прогу для win32, то запихни это в отдельный поток, организующий выход из програмы.
Автор:Alex Soloviev(2:5047/14.20)
-------------------------------------------------------------------------------

Предложения по улучшению FAQ
1. Сделать ссылку на тему "Системные функции и WinAPI/ Windows/Процессы, потоки, память, задачи/Как сделать, чтобы запускалась только одна копия приложения?" в разделе "Разработка приложений"
2. Перенести тему "Системные функции и WinAPI/ Windows/ Процессы, потоки, память,задачи/Запуск программ с передачей консольного ввода и чтением вывода?" в подраздел "../Консольные приложения", убрав из ее названия вопросительны знак.
3. В разделе VCL некоторые названия тем соответствующие названиям компонентов сожержат префикс "Т" (TForm, TEdit)а некоторые -- нет (Label, TreeView). Стоит привести их к общему виду.
4. В разделе "Delphi IDE, компилятор.../Ошибки в Дельфи/" есть тема ""Error reading symbol file." error" у которой не отображается название в дереве тем слева.


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

StayAtHome От меня лично большое спасибо за предоставленные примеры.
Vit, может, это уже предлагалось, не помню, но всё же: может, стоит сделать из FAQ два FAQ: один - общие вопросы, VCL, BD - самое популярное, второй - сети, инет, ActiveX, Kylix, .Net etc - потому как не очень красиво отсылать вопрошающего к пятиметровому файлу, а вот скачать, скажем, полтора метра - гораздо проще.