Witam
Interesuje mnie zrobienie takiego zaznaczania pól...
... jako aktywnych po najechaniu myszką - coś w rodzaju przycisku/panelu z możliwością ustawienia na nim dowolnych tekstów/grafik.
Wiele aplikacji takie rozwiązanie stosuje z Visty, np.: Kaspersky7 lub TuneUp Utilities 2008.
Bardzo proszę o przykład jak takie coś wykonać.
onOwnerDraw.
Polecam paczuszkę komponentów TMS mają takie bajery ala vista nawet w xp-ku.
Oto moja propozycja:
oraz kod na listboxie:
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Gradient: TBitmap;
begin
Gradient:= TBitmap.Create;
with (Control as TListBox).Canvas do
begin
if odSelected in State then
begin
Gradient.Width:= Rect.Right - Rect.Left;
Gradient.Height:= Rect.Bottom - Rect.Top;
Form1.Gradient(clWhite, RGB(200, 242, 249), Gradient);
CopyRect(Rect, Gradient.Canvas, Gradient.Canvas.ClipRect);
Brush.Color:= clWhite;
FrameRect(Rect);
Brush.Style:=bsClear;
Pen.Color:= RGB(157, 187, 189);
RoundRect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, 5, 5);
end
else
FillRect(Rect);
TextOut(Rect.Left+20, Rect.Top+10, Listbox1.Items[Index]);
end;
end;
procedure TForm1.Gradient(Col1, Col2: TColor; Bmp: TBitmap);
type
PixArray = array [1..3] of Byte;
var
h, w: Integer;
X, Y: Real;
p: ^PixArray;
begin
bmp.PixelFormat := pf24Bit;
for h := 0 to bmp.Height - 1 do
begin
p := bmp.ScanLine[h];
for w := 0 to bmp.Width - 1 do
begin
X:= w / bmp.Width;
Y:= h / bmp.Height;
p^[1] := Round(GetBvalue(Col1)*(1-Y)) + Round(GetBvalue(Col2)*Y);
p^[2] := Round(GetGvalue(Col1)*(1-Y)) + Round(GetGvalue(Col2)*Y);
p^[3] := Round(GetRvalue(Col1)*(1-Y)) + Round(GetRvalue(Col2)*Y);
Inc(p);
end;
end;
end;
AdamPL napisał(a)
Oto moja propozycja:
AdamPL bardzo ładnie, wyraźnie jest podobne ! Dzięki.
... tylko, że tutaj Adamie operujesz na TListView/TListBox. Z samą ikonką nie byłoby tutaj najmniejszego problemu, ale jak dodać tekst który służy za przycisk (na zdjęciu są to hiperłącza: Zatrzymaj | Wstrzymaj | Ustawienia ).
asstraffic napisał(a)
Polecam paczuszkę komponentów TMS mają takie bajery ala vista nawet w xp-ku.
Komponenty TMS są płatne, znam je. Przy uruchomieniu pod kompilatorem jest ok, ale bezpośrednio już jest komunikat "Trial version....".
Też narysować i obsłużyć akcje najechania/zjechania kursowa nowym rysowaniem, a kliknięcie sprawdzeniem czy to pozycja przycisku i ewentualnym obsłużeniem.
Zasiadłem do przeróbki o oto co mi z tego wyszło...
Jednak gdy okno jest nieaktywne, obwódka znika i "przycisk" ładnie się prezentuje. Więc jak usunąć tą czarną obwódkę ?
Pozostaje jeszcze kwestia hiperłączy zaznaczonych na czerwono
Dołączam źródła: http://www.sendspace.pl/file/q6UxnZQe
Jeśli ktoś będzie potrafił to poprawić, to proszę o pomoc :)
Zapomniałem dodać źródeł w Delphi bezpośrednio na forum.
procedure PaintGradient(Col1, Col2: TColor; Bmp: TBitmap);
type
PixArray = array [1..3] of Byte;
var
h, w: Integer;
y: Real;
p: ^PixArray;
begin
Bmp.PixelFormat := pf24Bit;
for h := 0 to Bmp.Height-1 do
begin
p := Bmp.ScanLine[h];
for w := 0 to Bmp.Width-1 do
begin
y := h / Bmp.Height;
p^[1] := Round(GetBvalue(Col1)*(1-y)) + Round(GetBvalue(Col2)*y);
p^[2] := Round(GetGvalue(Col1)*(1-y)) + Round(GetGvalue(Col2)*y);
p^[3] := Round(GetRvalue(Col1)*(1-y)) + Round(GetRvalue(Col2)*y);
Inc(p);
end;
end;
end;
procedure TForm1.ListBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Ico: TIcon;
Gradient: TBitmap;
Linia1, Linia2: TStringList;
begin
Ico := TIcon.Create;
Gradient := TBitmap.Create;
Linia1 := TStringList.Create;
Linia2 := TStringList.Create;
{Test pierwszej linii}
Linia1.Add('Ochrona komputera');
Linia1.Add('Zadanie nie zostało wykonane');
Linia1.Add('Data opublikowania baz danych');
{Test drugiej linii}
Linia2.Add('Zatrzymaj | Wstrzymaj | Ustawienia');
Linia2.Add('Ustawienia | Terminarz');
Linia2.Add('Ustawienia | Przywróć');
with (Control as TListBox).Canvas do
begin
if odSelected in State then
begin
Gradient.Width := Rect.Right - Rect.Left;
Gradient.Height := Rect.Bottom - Rect.Top;
PaintGradient(clWhite, RGB(200, 242, 249), Gradient);
CopyRect(Rect, Gradient.Canvas, Gradient.Canvas.ClipRect);
Brush.Color := clWhite;
FrameRect(Rect);
Brush.Style := bsClear;
Pen.Color := RGB(157, 187, 189);
RoundRect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, 10, 10);
Img1.GetIcon(1, Ico);
Draw(Rect.Left + 4, Rect.Top + 12, Ico);
end
else
begin
FillRect(Rect);
Img1.GetIcon(0, Ico);
Draw(Rect.Left + 4, Rect.Top + 12, Ico);
end;
{Linia główna}
Font.Name := 'Tahoma';
Font.Color := $00A68D00;
Font.Height := -13;
Font.Size := 10;
Font.Style := [fsBold];
TextOut(Rect.Left + 25, Rect.Top + 8, ListBox.Items[Index]);
{Linia pierwsza}
Font.Name := 'Tahoma';
Font.Color := clBlack;
Font.Height := -11;
Font.Size := 8;
Font.Style := [];
TextOut(Rect.Left + 25, Rect.Top + 30, Linia1.Strings[Index]);
{Linia druga}
Font.Name := 'Tahoma';
Font.Color := $00A68D00;
Font.Height := -11;
Font.Size := 8;
Font.Style := [];
TextOut(Rect.Left + 25, Rect.Top + 50, Linia2.Strings[Index]);
{Ikona po prawej}
{
Rect.Left := Rect.Left+2;
Rect.Right := Rect.Right-2;
Rect.Top := Rect.Top +2;
Rect.Bottom := Rect.Bottom-2;
Img1.GetIcon(2, Ico);
Draw(Rect.Right-30, Rect.Top + 10, Ico);
}
end;
Ico.Free;
Gradient.Free;
Linia1.Free;
end;
obwódkę o którą ci chodzi rysuje standardowo Windows i kiedyś tez szukałem jak to usunąć ale niestety nie znalazłem rozwiązania. Jeżeli kolor czcionki jest czarny to obwódki NIE MA (przynajmniej u mnie tak było) ale jak tylko zmienię kolor czcionki zaznaczonego elementu na jakiś inny to pojawia się ta obwódka.
puchi napisał(a)
obwódkę o którą ci chodzi rysuje standardowo Windows i kiedyś tez szukałem jak to usunąć ale niestety nie znalazłem rozwiązania. Jeżeli kolor czcionki jest czarny to obwódki NIE MA (przynajmniej u mnie tak było) ale jak tylko zmienię kolor czcionki zaznaczonego elementu na jakiś inny to pojawia się ta obwódka.
A no właśnie... czyli jednak nie da się inaczej ?
Poprawiłem kod, obwódka jest bo jest, ale mniej rzucająca się w oczy... tak jak napisałeś puchi.
{Linia pierwsza}
//...
Font.Color := clBlack; // DODANE
{Ikona po prawej}
{
Rect.Left := Rect.Left+2;
Rect.Right := Rect.Right-2;
Rect.Top := Rect.Top +2;
Rect.Bottom := Rect.Bottom-2;
Img1.GetIcon(2, Ico);
Draw(Rect.Right-30, Rect.Top + 10, Ico);
}
end;
//...
puchi napisał(a)
obwódkę o którą ci chodzi rysuje standardowo Windows i kiedyś tez szukałem jak to usunąć ale niestety nie znalazłem rozwiązania. Jeżeli kolor czcionki jest czarny to obwódki NIE MA (przynajmniej u mnie tak było) ale jak tylko zmienię kolor czcionki zaznaczonego elementu na jakiś inny to pojawia się ta obwódka.
Wystarczy sprawdzić, czy element ma focusa (w state chyba to jest) i jeśli tak, to użyć funkcji DrawFocusRect(), czy jakoś tak ;)
Poprawiłem co nieco, pousuwałem zbędne linie i zastosowałem DrawFocusRect;
Okno zaraz po uruchomieniu, okno jest aktywne, nie zaznaczone żadne pole, widnieje obwódka.
Zaznaczone pole, obwódka znikła.
Okno nie aktywne, zaznaczone pole, obwódka znowu aktywna.
W kodzie zaznaczyłem, gdzie funkcja DrawFocusRect wpływa na zmianę obwódki, ale funkcja nie działa, gdy okno staje się nie aktywne i nie może wtedy odmalować.
Nie poddam się.... może macie pomysły gdzie to poprawić ?
procedure PaintGradient(Col1, Col2: TColor; Bmp: TBitmap);
type
PixArray = array [1..3] of Byte;
var
h, w: Integer;
y: Real;
p: ^PixArray;
begin
Bmp.PixelFormat := pf24Bit;
for h := 0 to Bmp.Height-1 do
begin
p := Bmp.ScanLine[h];
for w := 0 to Bmp.Width-1 do
begin
y := h / Bmp.Height;
p^[1] := Round(GetBvalue(Col1)*(1-y)) + Round(GetBvalue(Col2)*y);
p^[2] := Round(GetGvalue(Col1)*(1-y)) + Round(GetGvalue(Col2)*y);
p^[3] := Round(GetRvalue(Col1)*(1-y)) + Round(GetRvalue(Col2)*y);
Inc(p);
end;
end;
end;
procedure TForm1.ListBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Ico: TIcon;
Gradient: TBitmap;
Linia1, Linia2: TStringList;
begin
Ico := TIcon.Create;
Gradient := TBitmap.Create;
Linia1 := TStringList.Create;
Linia2 := TStringList.Create;
{Test pierwszej linii}
Linia1.Add('Ochrona komputera');
Linia1.Add('Zadanie nie zostało wykonane');
Linia1.Add('Data opublikowania baz danych');
{Test drugiej linii}
Linia2.Add('Zatrzymaj | Wstrzymaj | Ustawienia');
Linia2.Add('Ustawienia | Terminarz');
Linia2.Add('Ustawienia | Przywróć');
with ListBox.Canvas do
begin
if (odSelected in State) then
begin
Gradient.Width := Rect.Right - Rect.Left;
Gradient.Height := Rect.Bottom - Rect.Top;
PaintGradient(clWhite, RGB(193, 243, 240), Gradient);
CopyRect(Rect, Gradient.Canvas, Gradient.Canvas.ClipRect);
Brush.Color := clWhite;
FrameRect(Rect);
Brush.Style := bsClear;
Pen.Color := RGB(150, 234, 229);
RoundRect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, 10, 10);
{Ikona po lewej}
Img1.GetIcon(1, Ico);
Draw(Rect.Left + 4, Rect.Top + 9, Ico);
{Ikona po prawej}
Img1.GetIcon(2, Ico);
Draw(Rect.Right - 25, Rect.Top + 7, Ico);
{Linia główna}
Font.Name := 'Tahoma';
Font.Color := $00A68D00;
Font.Height := -13;
Font.Size := 10;
Font.Style := [fsBold];
TextOut(Rect.Left + 25, Rect.Top + 8, ListBox.Items[Index]);
{Linia pierwsza}
Font.Color := clBlack;
Font.Height := -11;
Font.Size := 8;
Font.Style := [];
TextOut(Rect.Left + 25, Rect.Top + 30, Linia1.Strings[Index]);
{Linia druga}
Font.Color := $00A68D00;
Font.Height := -11;
Font.Size := 8;
Font.Style := [];
TextOut(Rect.Left + 25, Rect.Top + 50, Linia2.Strings[Index]);
//Font.Color := clBlack;
//miejsce gdzie trzeba sprawdzić, czy okno utraciło aktywność
if not Focused then DrawFocusRect(Rect);
//Exit;
end
else
begin
FillRect(Rect);
Img1.GetIcon(0, Ico);
Draw(Rect.Left + 4, Rect.Top + 9, Ico);
end;
{Ikona po prawej}
Img1.GetIcon(2, Ico);
Draw(Rect.Right - 25, Rect.Top + 7, Ico);
{Linia główna}
Font.Name := 'Tahoma';
Font.Color := $00A68D00;
Font.Height := -13;
Font.Size := 10;
Font.Style := [fsBold];
TextOut(Rect.Left + 25, Rect.Top + 8, ListBox.Items[Index]);
{Linia pierwsza}
Font.Color := clBlack;
Font.Height := -11;
Font.Size := 8;
Font.Style := [];
TextOut(Rect.Left + 25, Rect.Top + 30, Linia1.Strings[Index]);
{Linia druga}
Font.Color := $00A68D00;
Font.Height := -11;
Font.Size := 8;
Font.Style := [];
TextOut(Rect.Left + 25, Rect.Top + 50, Linia2.Strings[Index]);
//Font.Color := clBlack;
end;
Ico.Free;
Gradient.Free;
Linia1.Free;
Linia2.Free;
end;
Raczej o takie coś chodziło:
if odFocused in State then
Canvas.DrawFocusRect(Rect);
I powinno się to robić zawsze, nie tylko wtedy, gdy na elemencie jest zaznaczenie (odSelected).
thenkles napisał(a)
Raczej o takie coś chodziło:
if odFocused in State then
Canvas.DrawFocusRect(Rect);
I powinno się to robić zawsze, nie tylko wtedy, gdy na elemencie jest zaznaczenie (odSelected).
Thenkles Dzięki ! Teraz jest wszystko ok !
Wspólnymi siłami doszliśmy do finału... Dziękuję.
Kod teraz prezentuje się następująco:
procedure PaintGradient(Col1, Col2: TColor; Bmp: TBitmap);
type
PixArray = array [1..3] of Byte;
var
h, w: Integer;
y: Real;
p: ^PixArray;
begin
Bmp.PixelFormat := pf24Bit;
for h := 0 to Bmp.Height-1 do
begin
p := Bmp.ScanLine[h];
for w := 0 to Bmp.Width-1 do
begin
y := h / Bmp.Height;
p^[1] := Round(GetBvalue(Col1)*(1-y)) + Round(GetBvalue(Col2)*y);
p^[2] := Round(GetGvalue(Col1)*(1-y)) + Round(GetGvalue(Col2)*y);
p^[3] := Round(GetRvalue(Col1)*(1-y)) + Round(GetRvalue(Col2)*y);
Inc(p);
end;
end;
end;
procedure TForm1.ListBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Ico: TIcon;
Gradient: TBitmap;
Linia1, Linia2: TStringList;
begin
Ico := TIcon.Create;
Gradient := TBitmap.Create;
Linia1 := TStringList.Create;
Linia2 := TStringList.Create;
{Test pierwszej linii}
Linia1.Add('Ochrona komputera');
Linia1.Add('Zadanie nie zostało wykonane');
Linia1.Add('Data opublikowania baz danych');
{Test drugiej linii}
Linia2.Add('Zatrzymaj | Wstrzymaj | Ustawienia');
Linia2.Add('Ustawienia | Terminarz');
Linia2.Add('Ustawienia | Przywróć');
with ListBox.Canvas do
begin
if (odSelected in State) then
begin
Gradient.Width := Rect.Right - Rect.Left;
Gradient.Height := Rect.Bottom - Rect.Top;
PaintGradient(clWhite, RGB(193, 243, 240), Gradient);
CopyRect(Rect, Gradient.Canvas, Gradient.Canvas.ClipRect);
Brush.Color := clWhite;
FrameRect(Rect);
Brush.Style := bsClear;
Pen.Color := RGB(150, 234, 229);
RoundRect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, 10, 10);
{Ikona po lewej}
Img1.GetIcon(1, Ico);
Draw(Rect.Left + 4, Rect.Top + 9, Ico);
end
else
begin
FillRect(Rect);
{Ikona po lewej}
Img1.GetIcon(0, Ico);
Draw(Rect.Left + 4, Rect.Top + 9, Ico);
end;
{Ikona po prawej}
Img1.GetIcon(2, Ico);
Draw(Rect.Right - 25, Rect.Top + 7, Ico);
{Linia główna}
Font.Name := 'Tahoma';
Font.Color := $00A68D00;
Font.Height := -13;
Font.Size := 10;
Font.Style := [fsBold];
TextOut(Rect.Left + 25, Rect.Top + 8, ListBox.Items[Index]);
{Linia pierwsza}
Font.Color := clBlack;
Font.Height := -11;
Font.Size := 8;
Font.Style := [];
TextOut(Rect.Left + 25, Rect.Top + 30, Linia1.Strings[Index]);
{Linia druga}
Font.Color := $00A68D00;
Font.Height := -11;
Font.Size := 8;
Font.Style := [];
TextOut(Rect.Left + 25, Rect.Top + 50, Linia2.Strings[Index]);
if odFocused in State then DrawFocusRect(Rect);
end;
Ico.Free;
Gradient.Free;
Linia1.Free;
Linia2.Free;
end;
ps. Wesołych Świąt ;]
Ach, z tego zachwytu zapomniałem dodać, że nadal aktualne są pomysły, jak zrobić hiperłącza o których pisałem wcześniej.
Określasz (Left, Top, Right i Bottom) napisu i sprawdzasz czy kliknięto właśnie w tym obszarze.
przykład:
w zdarzeniu onClick Listboxa rób tak
Var
P: TPoint;
begin
GetCursorPos(P);
if (P.X > (Left+ListBox.Left+25))
and
(P.X < (Left+ListBox.Left+Canvas.TextWidth('Zatrzymaj')))
and
(P.Y > (Top+ListBox.Top+(ListBox.ItemIndex*ListBox.ItemHeight)+50))
and
(P.Y < Top+ListBox.Top+(ListBox.ItemIndex*ListBox.ItemHeight)+50+Canvas.TextHeight('Zatrzymaj')) then begin
//TU ZDARZENIE DLA NAPISU "ZATRZYMAJ"
Pisałem na szybko i zgłowy ale sama idea powinna ci pomoc możesz określić taki obszar dla każdego napisu i jeśli kursor znajduje się właśnie w tym obszarze wykona się żądana procedura. Mogłem pomylić wartości liczbowe więc posprawdzaj na swoim przykładzie.