Форум: "Система";
Текущий архив: 2002.05.23;
Скачать: [xml.tar.bz2];

Вниз

Работа с кнопкой   Найти похожие ветки 

← →
dimmu   (2002-02-24 20:00) [0]

Добрый день, Мастера! Я написал программу, которая отрисовывает на кнопке "Пуск" в виндах
новый рисунок. Я реализовал это копированием поверх этой кнопки своего Bitmap"а по
событию OnTimer. Понятно, что в этом случае нажатая и ненажатая кнопка выглядят одинако, да еще это постоянное мигание ... короче выглядит это не очень клево. Вот пример кода:

var
HW : HWND;
DC : HDC;
R : TRect;
Bitmap:TBitmap;
HW := FindWindowEx(FindWindow("Shell_TrayWnd",nil),0,"Button",nil);
GetWindowRect(HW,R);
DC := GetWindowDC(HW);
BitBlt(DC,0,0,R.Right-R.Left,R.Bottom-R.Top,
Bitmap.Canvas.Handle,0,0,SRCCOPY);


Но поискав в i-net’е подобную информацию я нашел вот этот вариант. Здесь все отрисовывается только один раз и этот Bitmap’ держится пока комп’ не перезагрузят или на кнопке отрисуют старый Bitmap’. Очевидно, что это реализация намного лучше, если бы не оно ‘но’: она не корректно работает – в этом то весь и вопрос – с кнопки «Пуск» стирается старый Bitmap’, а новый не отрисовывается – я проверял это и в w2k и в w98. Помогите найти ошибку, пожалуйста, или посоветуйте альтернативное решение!


var
StartButton: РWТВ;
OldBitmap: THandle;
NewImage: TPicture;
begin
NewImage := TPicture.create;
NewImage.LoadFromFile("C:\Windows\delphi.BMP"); //рисунок, который будет
помещен вместо оригинального
StartButton := FindWindowEx(FindWindow("Shell_TrayWnd", nil),0,"Button", nil);
OldBitmap := SendMessage(StartButton,BM_SetImage, 0,NewImage.Bitmap.Handle);
end;


---

← →
VuDZ   (2002-02-25 02:25) [1]

одно предположение - OldBitmap == 0? так?

---

← →
Sasha9   (2002-02-25 12:42) [2]

другое предложение - использовать 2-й вариант и не закрывать прогу до выключения компа

---

← →
VuDZ   (2002-02-25 15:24) [3]

тут вся проблема в IPC - interprocess communication :>

---

← →
Севостьянов Игорь   (2002-02-25 17:53) [4]

Во втором примере все верно, но твое "но" просто как пень

Oh, and this will work only in Windows 9x. NT will not allow the happy-go-lucky transfer of the bitmap handle between processes.
А насчет изящного решения надо подумать...

---

← →
Севостьянов Игорь   (2002-02-26 11:11) [5]

Ну что ж немного повозившись с этой проблемой я пришел к выводу, что MS все-таки намудрила с BITMAP ничего не выйдет для кнопки в другом процессе. Ведь для кнопки на текущей формы все проходит безболезненно. Но вот для текста или иконки все нормально. Вот код который работает под win2000:
unit Unit1;

interface

uses
Windows, Messages, Graphics, Forms, StdCtrls, Controls, Classes;

type
TForm1 = class(TForm)
btnNewText: TButton;
btnNewIcon: TButton;
procedure btnNewTextClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnNewIconClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
StartButton: HWND;
Style: DWORD;
NewImage: TPicture;
OldBitmap: THandle;
OldText: PChar;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
StartButton := FindWindowEx(FindWindow("Shell_TrayWnd", nil),0,"Button", nil);
Style := GetWindowLong(StartButton, GWL_STYLE);
OldBitmap := SendMessage(StartButton, BM_GETIMAGE, IMAGE_BITMAP, 0);
GetWindowText(StartButton, OldText, MAX_PATH);
NewImage := TPicture.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
SetWindowLong(StartButton, GWL_STYLE, Style);
SendMessage(StartButton, BM_SETIMAGE, IMAGE_BITMAP, OldBitmap);
SetWindowText(StartButton, OldText);
NewImage.Free;
end;

procedure TForm1.btnNewTextClick(Sender: TObject);
begin
SetWindowLong(StartButton, GWL_STYLE, (Style or BS_TEXT) - BS_BITMAP);
SetWindowText(StartButton, "СТАРТ");
end;

procedure TForm1.btnNewIconClick(Sender: TObject);
begin
SetWindowLong(StartButton, GWL_STYLE, (Style or BS_ICON) - BS_BITMAP);
NewImage.Icon.LoadFromFile("start.ico");
SendMessage(StartButton, BM_SETIMAGE, IMAGE_ICON, NewImage.Icon.Handle);
end;

end.

На этом я закончил рассмотрение и решение данной проблемы, хотя вообще-то можно еще на кнопку(или таскбар) добавить и свой контрол (кнопку смотри Windows.SetParent(..)), а кнопку спрятать (смотри ShowWindow(hWnd, SW_HIDE))

---

← →
AlexKniga   (2002-02-26 18:30) [6]

А в реестре прописать свои изыски не проще?

На память я путь не помню, но если надо могу поискать.

---

← →
Sasha9   (2002-02-26 19:38) [7]

2AlexKniga
подскажи,плиз

---

← →
SeF   (2002-02-27 02:53) [8]

под 9х все ОК, но под 2к просто очищает поверхность.
var
StartButton: hWnd;
bmOld: THandle;
bm: TBitMap;
izmeneno:boolean;

procedure TForm1.Button3Click(Sender: TObject);
const
text = "SeF";
var
r: TRect;
i: integer;
begin

if izmeneno then
begin
showmessage("Кнопка уже изменена!");
exit;
end;
StartButton := FindWindowEx(FindWindow("Shell_TrayWnd",nil), 0, "Button", nil);
bm := TBitMap.Create;
bmOld := SendMessage(StartButton, BM_GETIMAGE, 0, 0);
GetWindowRect(StartButton, r);
bm.Width := r.Right - r.Left - 8;
bm.Height := r.Bottom - r.Top - 6;
with bm.Canvas do begin
Brush.Color := clBtnFace;
FillRect(ClipRect);
for i := 0 to bm.Width + 4 do begin
Pen.Color := RGB(i * 4, 255, 0);
MoveTo(i - 5, 0);
LineTo(i, bm.Height);
end;

Brush.Style := bsClear;
Font.Style := [fsBold];
Font.Name := "Arial";
Font.Size := 9;
Font.Color := clBlue;

TextOut((bm.Width - TextWidth(text)) div 2,
(bm.Height - TextHeight(text)) div 2, text);
end;
SendMessage(StartButton, BM_SETIMAGE, 0, bm.Handle);
izmeneno := true;
button4.Enabled := true;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
SendMessage(StartButton, BM_SetImage, 0, bmOld);
bm.Destroy;
izmeneno:=false;
button4.Enabled :=false;
end;

---

Страницы: 1 вся ветка

Форум: "Система";
Текущий архив: 2002.05.23;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.007 c