500+ FAQ по Delphi

Перейти на: Главную | Индексную | Предыдущую | Следующую страницу
натяжные потолки в Климовске

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

Рабочий стол перекрыт сверху компонентом ListView.
Вам просто необходимо взять хэндл этого органа управления. Пример:

function GetDesktopListViewHandle: THandle;
var
S: String;
begin
Result := FindWindow('ProgMan', nil);
Result := GetWindow(Result, GW_CHILD);
Result := GetWindow(Result, GW_CHILD);
SetLength(S, 40);
GetClassName(Result, PChar(S), 39);
if PChar(S) <> 'SysListView32' then Result := 0;
end;

После того, как Вы взяли тот хэндл, Вы можете использовать API этого ListView,
определенный в модуле CommCtrl, для того, чтобы манипулировать рабочим столом.
Смотрите тему "LVM_xxxx messages" в оперативной справке по Win32.

К примеру, следующая строка кода:
SendMessage( GetDesktopListViewHandle, LVM_ALIGN, LVA_ALIGNLEFT, 0 );
разместит иконки рабочего стола по левой стороне рабочего стола Windows.

Как я могу использовать анимированный курсор?

Сперва Вы должны взять хэндл курсора Windows и присвоить его одному из
элементов массива Cursors обьекта Screen.
Предопределенные курсоры имеют отрицательный индекс, а определенные
пользователем (Вами) курсоры получают положительные индексы.

Ниже пример формы, использующей анимированный курсор:

procedure TForm1.Button1Click(Sender: TObject);
var
h : THandle;
begin
h := LoadImage(0,
'C:\TheWall\Magic.ani',
IMAGE_CURSOR,
0,
0,
LR_DEFAULTSIZE or
LR_LOADFROMFILE
);
if h = 0 then ShowMessage('Cursor not loaded')
else
begin
Screen.Cursors[1] := h;
Form1.Cursor := 1;
end;
end;

Как создать disable'ный битмап из обычного (emboss etc)?

CreateMappedBitmap() :-)

Один из паpаметpов yказатель на COLORMAP, в нем для 16 основных цветов делаешь
пеpекодиpовкy, цвета подбеpешь сам из пpинципа:
все самые яpкие -> в GetSysColor( COLOR_3DLIGHT );
самые темные -> GetSysColor( COLOR_3DSHADOW );
нейтpальные, котpые бyдyт пpозpачные -> GetSysColor( COLOR_3DFACE );

Так на самом деле вот как делается данная задача:

procedure Tform1.aaa(bmpFrom,bmpTo:Tbitmap);
var
TmpImage,Monobmp:TBitmap;
IRect:TRect;
begin
MonoBmp := TBitmap.Create;
TmpImage:=Tbitmap.Create;
TmpImage.Width := bmpFrom.Width;
TmpImage.Height := bmpFrom.Height;
IRect := Rect(0, 0, bmpFrom.Width, bmpFrom.Height);
TmpImage.Canvas.Brush.Color := clBtnFace;
try
with MonoBmp do
begin
Assign(bmpFrom);
Canvas.Brush.Color := clBlack;
if Monochrome then
begin
Canvas.Font.Color := clWhite;
Monochrome := False;
Canvas.Brush.Color := clWhite;
end;
Monochrome := True;
end;
with TmpImage.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(IRect);
Brush.Color := clBlack;
Font.Color := clWhite;
CopyMode := MergePaint;
Draw(IRect.Left + 1, IRect.Top + 1, MonoBmp);
CopyMode := SrcAnd;
Draw(IRect.Left, IRect.Top, MonoBmp);
Brush.Color := clBtnShadow;
Font.Color := clBlack;
CopyMode := SrcPaint;
Draw(IRect.Left, IRect.Top, MonoBmp);
CopyMode := SrcCopy;
bmpTo.assign(TmpImage);
TmpImage.free;
end;
finally
MonoBmp.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
aaa(image1.picture.bitmap,image2.picture.bitmap);
Image2.invalidate;
end;

Писал это не я. Это написал сам Борланд (некузявно было бы взглянуть на
класс TButtonGlyph. Как раз из него я это и выдернул).

Hу а если уже совсем хорошо разобраться, то можно заметить функцию
ImageList_DrawEx, в которой можно на 25 и 50 процентов уменьшить яркость
(но визуально это очень плохо воспринимается). Соответственно
параметры ILD_BLEND25, ILD_BLEND50, ILD_BLEND-A-MED. Естественно, что
последний абзац работает только с тройкой.

Это кусочек из рабочей проги на Си, Вроде все лишнее я убрал.

#define CO_GRAY 0x00C0C0C0L

hMemDC = CreateCompatibleDC(hDC);
hOldBitmap = SelectObject(hMemDC, hBits);

// hBits это собственно картинка, которую надо "засерить"

GetObject(hBits, sizeof(Bitmap), (LPSTR) &Bitmap);

if ( GetState(BS_DISABLED) ) // Blt disabled
{
hOldBrush = SelectObject(hDC, CreateSolidBrush(CO_GRAY));//CO_GRAY

PatBlt(hDC, BD_BORDERWIDTH, BD_BORDERWIDTH, Bitmap.bmWidth,
Bitmap.bmHeight, PATCOPY);
DeleteObject(SelectObject(hDC, hOldBrush));

lbLogBrush.lbStyle = BS_PATTERN;
lbLogBrush.lbHatch =(int)LoadBitmap(hInsts,
MAKEINTRESOURCE(BT_DISABLEBITS));
hOldBrush = SelectObject(hDC, CreateBrushIndirect(&lbLogBrush));

BitBlt(hDC, BD_BORDERWIDTH, BD_BORDERWIDTH, Bitmap.bmWidth,
Bitmap.bmHeight, hMemDC, 0, 0, 0x00A803A9UL); // DPSoa

DeleteObject(SelectObject(hDC, hOldBrush));
DeleteObject((HGDIOBJ)lbLogBrush.lbHatch);
}

Как запретить кнопку Close [x] в заголовке окна.

Вот кусок, который делает все, что тебе нужно:

procedure TForm1.FormCreate(Sender: TObject);
var
Style: Longint;
begin
Style := GetWindowLong(Handle, GWL_STYLE);
SetWindowLong(Handle, GWL_STYLE, Style And Not WS_SYSMENU);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_F4) and (ssAlt in Shift) then begin
MessageBeep(0);
Key := 0;
end;
end;

{ Disable close button }
procedure TForm1.Button1Click(Sender: TObject);
var
SysMenu: HMenu;
begin
SysMenu := GetSystemMenu(Handle, False);
Windows.EnableMenuItem(SysMenu, SC_CLOSE, MF_DISABLED or MF_GRAYED);
end;

{ Enable close button }
procedure TForm1.Button2Click(Sender: TObject);
begin
GetSystemMenu(Handle, True);
Perform(WM_NCPAINT, Handle, 0);
end;

Но это окно можно закрыть из TaskBar'а.

Как скопировать экран (или его часть) в TBitmap?

Например, с помощью WinAPI так -

var
bmp: TBitmap;
DC: HDC;

begin

bmp:=TBitmap.Create;

bmp.Height:=Screen.Height;
bmp.Width:=Screen.Width;

DC:=GetDC(0); //Дескpиптоp экpана

bitblt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
DC, 0, 0, SRCCOPY);

bmp.SaveToFile('Screen.bmp');

ReleaseDC(0, DC);
end;

Или с помощью обертки TCanvas -

Объект Screen[.width,height] - размеры

Var
Desktop :TCanvas ;
BitMap :TBitMap;

begin
DesktopCanvas:=TCanvas.Create;
DesktopCanvas.Handle:=GetDC(Hwnd_Desktop);
BitMap := TBitMap.Create;
BitMap.Width := Screen.Width;
BitMap.Height:=Screen.Height;
Bitmap.Canvas.CopyRect(Bitmap.Canvas.ClipRect,
DesktopCanvas, DesktopCanvas.ClipRect);
...
end;

Как убрать всплывающие подсказки в TreeView?

TCustomTreeView.WMNotify. О том, что такое
тип notify'а TTM_NEEDTEXT пpочтешь в хелпе. Убpать хинты можно, пеpекpыв
обpаботчик для этого уведомительного сообщения.

Как изменить внешний вид хинтов (всплывающих подсказок)?

1. Создаем свой класс - потомок от THintWindow

type
TCustomHint = class (THintWindow)
public
constructor Create(AOwner: TComponent); override;
end;

Пpимечание 1. Этот способ не позволит изменить цвет шpифта - для этого
пpидется пеpекpывать метод Paint;

Пpимечание 2. Если пеpекpыть CreateParams, то можно, напpимеp, наpисовать
Hint в фоpме облачка.

Пpимечание 3. Для изменения цвета фона F1 TApplication.OnShowHint, HintInfo.

2. Меняем фонт:

constructor TCustomHint.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
with Canvas.Font do // Именно так, а не пpосто Font!
begin
Name := 'Times New Roman Cyr';
Style := [fsBold, fsItalic];
Size := 40;
end;
end;

3. Устанавливаем новый хинт

procedure TForm1.FormCreate(Sender: TObject); // Это может быть любой
begin // обpаботчик
HintWindowClass := TMyHint; // Устанавливаем глобальную пеpеменную
Application.ShowHint := false; // Application.FHintWindow.Free
Application.ShowHint := true; // Application.FHintWindow.Create
end;

Литеpатуpа:
1. <...>\Source\VCL\Forms.pas (TApplication).
2. <...>\Source\VCL\Controls.pas (THintWindow).
3. Delphi Help (OnShowHint, THintInfo).

Как перевести визуальный компонент, такой, как TPanel, в состояние перемещения (взять и перенести)?

Пример:
{ В случае Panel1:TPanel - обработчик события OnMouseDown }

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
SC_DragMove = $F012; { a magic number }
begin
ReleaseCapture;
panel1.perform(WM_SysCommand, SC_DragMove, 0);
end;

Как послать самостийное сообщение всем главным окнам в 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.

Как проиграть Wave-ресурс?

Сначала делаешь файл SOUND.RC, в нем строка вида: MY_WAV RCDATA TEST.WAV
Компилишь чем-нибyдь в *.RES

Далее в тексте:
{$R полное_имя_файла_с_ресурсом}

var WaveHandle : THandle;
WavePointer : pointer;
...
WaveHandle := FindResource(hInstance,'MY_WAV',RT_RCDATA);
if WaveHandle<>0 then begin
WaveHandle:= LoadResource(hInstance,WaveHandle);
if WaveHandle<>0 then begin;
WavePointer := LockResource(WaveHandle);
PlayResourceWave := sndPlaySound(WavePointer,snd_Memory OR
SND_ASYNC);
UnlockResource(WaveHandle);
FreeResource(WaveHandle);
end;
end;

Как правильно завершить некое приложение?

Если не принудительно, то можно послать на его Instance сообщение WM_QUIT.
Если же необходимо принудительно терминировать приложение, то смотрите ниже -
Под Windows NT процесс можно терминировать через специально предназначенный
для этого хэндл. Иначе гарантии нет.

Предположим, что процесс создаем мы, ожидая его завершения в течение
maxworktime. Тогда
var
dwResult: Longint; // This example was converted from C source.
begin // Not tested. Some 'nil' assignments must be applied
// as zero assignments in Pascal. Some vars need to
// be declared (maxworktime, si, pi). AA.
if CreateProcess(nil, CmdStr, nil, nil, FALSE,
CREATE_NEW_CONSOLE, nil, nil, si, pi) then
begin
CloseHandle( pi.hThread );
dwResult := WaitForSingleObject(pi.hProcess, maxworktime*1000*60);
CloseHandle( pi.hProcess );
if dwResult <> WAIT_OBJECT_0 then
begin
pi.hProcess := OpenProcess(PROCESS_TERMINATE, FALSE, pi.dwProcessId);
if pi.hProcess <> nil then
begin
TerminateProcess(pi.hProcess, 0);
CloseHandle(pi.hProcess);
end;
end;
end;
end;

Как удалить файл в корзину (Recycle Bin)?

program del;

uses
ShlObj;

//function SHFileOperation(const lpFileOp: TSHFileOpStruct): Integer; stdcall;

Var T:TSHFileOpStruct;
P:String;
begin
P:='C:\Windows\System\EL_CONTROL.CPL';
With T do
Begin
Wnd:=0;
wFunc:=FO_DELETE;
pFrom:=Pchar(P);
fFlags:=FOF_ALLOWUNDO
End;
SHFileOperation(T);
End.


Материалы находятся на сайте http://cracklab.narod.ru/faq/


Создатель этого HTML файла не претендует на авторство вопросов/ответов представленных в нём, не отвечает за их содержание и достоверность, а также за последствия использования программных кодов , полученных из этого HTML файла. Также не принимаются претензии относительно не размещённой информации об авторе каждого конкретного FAQ'а. Любые другие вопросы присылайте на bad_guy@cracklab.ru (обращаться к Bad_guy'ю).
Hosted by uCoz