Tipy a triky v Delphi, díl 42.

Změna obrázku tlačítka Start

Už dlouho jsme se nepokoušeli nějak "potrápit" Windows, takže si to tímto tipem zase trošku vynahradíme. Změna obrázku na tlačítku Start sice není dvakrát užitečná záležitost, ale proč se trošku nepobavit.

Nejprve si vytvořte vhodný obrázek patřičných rozměrů (mně se osvědčily rozměry přibližně 48 x 16 pixelů) a pak již stačí jen použít následující kód:

.
.
.
private
    { Private declarations }
      StartButton : hWnd;
      OldBitmap : THandle;
      NewImage : TPicture;
.
.
.

procedure TForm1.Button1Click(Sender: TObject);
begin
NewImage := TPicture.Create;
NewImage.LoadFromFile(`start.bmp`);
StartButton := FindWindowEx(FindWindow(`Shell_TrayWnd`, nil), 0, `Button`, nil);
OldBitmap := SendMessage(StartButton, BM_SetImage, 0, NewImage.Bitmap.Handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    try
        SendMessage(StartButton, BM_SetImage, 0, OldBitmap);
        NewImage.Free;
    except end;
end;

Změna obrázku je opět vyvolána jako událost stisku tlačítka, a abychom nebyli na Windows tak zlí, po ukončení příkladu se vše vrátí do původního stavu v události OnDestroy formuláře.

Nutno připomenout, že Windows se brání seč můžou a tento příklad bude fungovat jen na "starší generaci", tj. Windows 9x. Pod Windows NT/2000 se zobrazí pouze prázdné tlačítko.

Další vylepšení komponenty Edit

A máme tu další vylepšení komponenty Edit. Abych se přiznal, jako odchovanec osmibitových počítačů a dalších podobných staříků jsem měl moc rád, když kurzor při zadávání textu měl podobu blikajícího čtverečku a ve Windows (a dalších systémech) používaná svislá "čárka" se mi moc nelíbí. Ukážeme si teď, jak u komponenty Edit tento svislý a poněkud nudný kurzor změnit.

Umístěte si tedy na formulář nějaký EditBox a pak přidejte následující kód:

.
.
.
public
  { Public declarations }
  CaretBm : TBitmap;
  CaretBmBk : TBitmap;
  OldEditsWindowProc : Pointer;
.
.
.
type
  WParameter = LongInt;
  LParameter = LongInt;
.
.
.
function NewWindowProc(WindowHandle : hWnd; TheMessage : WParameter; ParamW : WParameter; ParamL : LParameter) : LongInt stdcall;
begin
  NewWindowProc := CallWindowProc(Form1.OldEditsWindowProc, WindowHandle, TheMessage, ParamW, ParamL);
  if TheMessage = WM_SETFOCUS then
  begin
  CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
  ShowCaret(WindowHandle);
  end;
  if TheMessage = WM_KILLFOCUS then
  begin
  HideCaret(WindowHandle);
  DestroyCaret;
  end;
  if TheMessage = WM_KEYDOWN then
  begin
  if ParamW = VK_BACK then
    CreateCaret(WindowHandle, Form1.CaretBmBk.Handle, 0, 0) else
    CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
  ShowCaret(WindowHandle);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CaretBm := TBitmap.Create;
  CaretBm.Canvas.Font.Name := `WingDings`;
  CaretBm.Canvas.Font.Height := Edit1.Font.Height;
  CaretBm.Canvas.Font.Color := clWhite;
  CaretBm.Width := CaretBm.Canvas.TextWidth(`J`) + 2;
  CaretBm.Height := CaretBm.Canvas.TextHeight(`J`) + 2;
  CaretBm.Canvas.Brush.Color := clBlue;
  CaretBm.Canvas.FillRect(Rect(0, 0, CaretBm.Width, CaretBm.Height));
  CaretBm.Canvas.TextOut(1, 1, `J`);
{-----------------------------------------------------------------}
  CaretBmBk := TBitmap.Create;
  CaretBmBk.Canvas.Font.Name := `WingDings`;
  CaretBmBk.Canvas.Font.Height := Edit1.Font.Height;
  CaretBmBk.Canvas.Font.Color := clWhite;
  CaretBmBk.Width := CaretBmBk.Canvas.TextWidth(`L`) + 2;
  CaretBmBk.Height := CaretBmBk.Canvas.TextHeight(`L`) + 2;
  CaretBmBk.Canvas.Brush.Color := clBlue;
  CaretBmBk.Canvas.FillRect(Rect(0, 0, CaretBmBk.Width, CaretBmBk.Height));
  CaretBmBk.Canvas.TextOut(1, 1, `L`);
  OldEditsWindowProc := Pointer(SetWindowLong(Edit1.Handle, GWL_WNDPROC, LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
SetWindowLong(Edit1.Handle, GWL_WNDPROC, LongInt(OldEditsWindowProc));
CaretBm.Free;
CaretBmBk.Free;
end;

Funkce NewWindowProc se vlastně stará o celé řízení samotného psaní textu, stará se o reakce na focus a na stisknutí kláves. Jako kurzor (či spíše kurzory – viz dále) se používá "obrázek", vytvořený v události OnCreate hlavního formuláře. Ta má dvě části, které jsou pro přehlednost odděleny čárou. První část popisuje vizuální podobu kurzoru při psaní textu, druhá část zase stejným způsobem nastavuje podobu kurzoru při mazání textu klávesou Backspace.

A jak tedy celý výsledek vypadá? Kurzor je jednak vykreslen ve tvaru "kostičky" a jako třešnička na dortu (a spíše z důvodů demonstračních než pro reálné použití) se na něm zobrazuje během psaní smějící se "smajlík" ze znakové sady WingDings. V případě mazání textu klávesou Backspace se smajlík změní na zamračeného.

Myslím, že princip samotné tvorby kurzoru je dostatečně zřejmý, takže se nebojte experimentování.