jvgasklistbox.pas

East make Tray Icon in delphi

      (not IsItAFilledBitmap(WallpaperBmp)) then
      Canvas.FillRect(BtnRect);
    BtnTxtRect := BtnRect;
    if FPushedButton[Index] = I then
    begin
      DrawLBItem(idsRecessed, BtnRect);
      OffsetRect(BtnTxtRect, 1, 1);
    end
    else
      DrawLBItem(idsRaised, BtnRect);
    //...button text
    if FPushedButton[Index] = I then
      ItemStyle.BtnFont.Style := [fsBold]
    else
      ItemStyle.BtnFont.Style := [];
    DrawTextInRect(BtnTxtRect, FCaptionsAlign_ or DT_SINGLELINE, I);
    Inc(BtnRect.Left, FButtonWidth + 1);
    Inc(BtnRect.Right, FButtonWidth + 1);
  end;

  MouseClickPoint.X := -1;
  MouseClickPoint.Y := 0;

  Rect1.Left := 3;
  Rect1.Right := FSegment1Width;

  Inc(Rect1.Top);
  Inc(Rect.Left);
  Dec(Rect1.Bottom);
  Dec(Rect.Right);

  if (FShowGlyphs) and (FGlyphs <> nil) and
    (FGlyphs.Width > 0) and (FGlyphs.Height > 0) then
  begin
    DrawGlyph(Rect, Index, Shift);
    Rect1.Left := Rect1.Left + FGlyphs.Width;
  end;
  //...text
  DrawTextInRect(Rect1, FTextAlign_, -1);

  with Msg.DrawItemStruct^ do
    if (odFocused in State) and (aloShowFocus in Options) then
      DrawFocusRect(hDC, rcItem);

  FSelectedItem := Index;
  if OldPushedBtn <> FPushedButton[Index] then
    ButtonClicked;
  Canvas.Handle := 0;
end;

procedure TJvgAskListBox.DrawWallpaper(R: TRect);
var
  X, Y, SaveIndex: Integer;
  UpdateRgn: HRGN;
begin
  X := 0;
  Y := 0;
  SaveIndex := SaveDC(Canvas.Handle);
  UpdateRgn := CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom);

  SelectClipRgn(Canvas.Handle, UpdateRgn);
  case WallpaperOption of
    fwoStretch:
      Canvas.StretchDraw(R, WallpaperBmp);
    fwoTile:
      while X < R.Right - R.Left do
      begin
        while Y < R.Bottom - R.Top do
        begin
          Canvas.Draw(R.Left + X, R.Top + Y, WallpaperBmp);
          Inc(Y, WallpaperBmp.Height);
        end;
        Inc(X, WallpaperBmp.Width);
        Y := 0;
      end;
  else
    Canvas.Draw(R.Left, R.Top, WallpaperBmp);
  end;
  DeleteObject(UpdateRgn);
  RestoreDC(Canvas.Handle, SaveIndex);
end;

procedure TJvgAskListBox.DrawGlyph(R: TRect; Index: Word; Shift: Word);
var
  I: Integer;
  OldRect: TRect;
begin
  if (FGlyphs = nil) or (FGlyphs.Count = 0) then
    Exit;
  R.Right := R.Left + FSegment1Width - 4;
  OldRect := R;
  Inc(R.Top);
  Inc(R.Left);
  case FGlyphsAlign.Horizontal of
    fhaCenter:
      OffsetRect(R, (R.Right - R.Left - Glyphs.Width) div 2, 0);
    fhaRight:
      OffsetRect(R, R.Right - R.Left - Glyphs.Width - Shift, 0);
  end;
  case FGlyphsAlign.Vertical of
    fvaCenter:
      OffsetRect(R, 0, (R.Bottom - R.Top - Glyphs.Height) div 2);
    fvaBottom:
      OffsetRect(R, 0, R.Bottom - R.Top - Glyphs.Height - Shift);
  end;

  I := -1;
  if NumGlyphs = 1 then
    I := 0
  else
  if Index < NumGlyphs then
    I := Index;
  if I >= 0 then
  begin
    FGlyphs.GetBitmap(I, TmpBitmap);
    if FAutoTransparentColor = ftcUser then
      CreateBitmapExt(Canvas.Handle, TmpBitmap, Rect(0, 0, 100, 100), R.Left,
        R.Top, fwoNone, fdsDefault, True, FTransparentColor, clBlack)
    else
      CreateBitmapExt(Canvas.Handle, TmpBitmap, Rect(0, 0, 100, 100), R.Left,
        R.Top, fwoNone, fdsDefault, True,
        GetTransparentColor(TmpBitmap, FAutoTransparentColor), clBlack);
  end;
end;

procedure TJvgAskListBox.SetAutoTransparentColor(Value: TglAutoTransparentColor);
begin
  if FAutoTransparentColor = Value then
    Exit;
  FAutoTransparentColor := Value;
  Invalidate;
end;

procedure TJvgAskListBox.SetWallpaper(Value: TBitmap);
begin
  if Assigned(FWallpaper) then
    FWallpaper.Free;
  FWallpaper := TBitmap.Create;
  FWallpaper.Assign(Value);
  if (not Assigned(Value)) and Assigned(WallpaperImage) then
    if Assigned(FWallpaper) then
      WallpaperBmp := FWallpaper
    else
    if Assigned(FWallpaperImage) then
      WallpaperBmp := FWallpaperImage.Picture.Bitmap
    else
      WallpaperBmp := nil;

  if FShowWallpaper then
    Invalidate;
end;

function TJvgAskListBox.GetWallpaper: TBitmap;
begin
  if not Assigned(FWallpaper) then
    FWallpaper := TBitmap.Create;
  WallpaperBmp := FWallpaper;
  Result := FWallpaper;
end;

procedure TJvgAskListBox.SetWallpaperImage(Value: TImage);
begin
  FWallpaperImage := Value;
  if (not IsItAFilledBitmap(FWallpaper)) and Assigned(Value) then
  begin
    WallpaperBmp := Value.Picture.Bitmap;
    if FShowWallpaper then
      Invalidate;
  end;
end;

procedure TJvgAskListBox.SetWallpaperOption(Value: TglWallpaperOption);
begin
  FWallpaperOption := Value;
  if FShowWallpaper then
    Invalidate;
end;

procedure TJvgAskListBox.SetNumGlyphs(Value: Word);
begin
  if Value < 1 then
    Exit;
  FNumGlyphs := Value;
  if FShowGlyphs then
    Invalidate;
end;

{procedure TJvgAskListBox.SetItemStyle( Value: TItemsDrawStyle );
begin
  if FItemStyle = Value then Exit;
  FItemStyle := Value;
  Invalidate;
end;

procedure TJvgAskListBox.SetSelItemStyle( Value: TItemsDrawStyle );
begin
  if FSelItemStyle = Value then Exit;
  FSelItemStyle := Value;
  Invalidate;
end;
}

procedure TJvgAskListBox.SetGlyphs(Value: TImageList);
begin
  //if (Value=nil)or(Value.Width<=0)or(Value.Height<=0) then Exit;
  FGlyphs := Value;
  if FShowGlyphs then
    Invalidate;
end;

{procedure TJvgAskListBox.SetSelFont( Value: TFont );
begin
  if Value=nil then Exit;
  FSelFont.Assign( Value );
  Invalidate;
end;
}

{
procedure TJvgAskListBox.SetColor(Value: TColor);
begin
  if FColor = Value then Exit;
  FColor := Value; Canvas.Brush.Color:=Value; Invalidate;
end;

procedure TJvgAskListBox.SetSelColor(Value: TColor);
begin
  if FColor = Value then Exit;
  FSelColor := Value; Canvas.Brush.Color:=Value; Invalidate;
end;
}

procedure TJvgAskListBox.SetItemHeight(Value: Word);
begin
  if (Value > 6) and (FItemHeight <> Value) then
  begin
    FItemHeight := Value;
    //inherited ItemHeight:=FItemHeight;
    RecalcHeights;
  end;
end;

procedure TJvgAskListBox.SetAlign(Align: TJvg2DAlign; var Align_: UINT);
begin
  case Align.Horizontal of
    fhaLeft:
      Align_ := Align_ or DT_LEFT;
    fhaCenter:
      Align_ := Align_ or DT_CENTER;
  else
    Align_ := Align_ or DT_RIGHT;
  end;
  case Align.Vertical of
    fvaTop:
      Align_ := Align_ or DT_TOP;
    fvaCenter:
      Align_ := Align_ or DT_VCENTER;
  else
    Align_ := Align_ or DT_BOTTOM;
  end;
end;

{
procedure TJvgAskListBox.SetTextStyle(Value: TglTextStyle);
begin
  if FTextStyle = Value then Exit;
  FTextStyle := Value; if FShowText then Invalidate;
end;

procedure TJvgAskListBox.SetButtonsTextStyle(Value: TglTextStyle);
begin
  if FButtonsTextStyle = Value then Exit;
  FButtonsTextStyle := Value; if FShowText then Invalidate;
end;
}

procedure TJvgAskListBox.SetShowText(Value: Boolean);
begin
  if FShowText <> Value then
  begin
    FShowText := Value;
    Invalidate;
  end;
end;

procedure TJvgAskListBox.SetTransparentColor(Value: TColor);
begin
  if FTransparentColor <> Value then
  begin
    FTransparentColor := Value;
    if FShowGlyphs then
      Invalidate;
  end;
end;

procedure TJvgAskListBox.SetButtonWidth(Value: Word);
begin
  if FButtonWidth <> Value then
  begin
    FButtonWidth := Value;
    RecalcHeights;
  end;
end;

procedure TJvgAskListBox.SetOptions(Value: TglAskLBOptions);
begin
  if FOptions <> Value then
  begin
    FOptions := Value;
    RecalcHeights;
  end;
end;

function TJvgAskListBox.IsFilled: Boolean;
var
  I: Word;
begin
  Result := False;
  for I := 0 to Items.Count - 1 do
    if FPushedButton[I] = 0 then
      Exit;
  Result := True;
end;

function TJvgAskListBox.CountPushedButtonsInColon(Colon: Integer): Integer;
var
  I: Word;
begin
  Result := 0;
  if Colon = 0 then
  begin
    for I := 0 to Items.Count - 1 do
      if FPushedButton[I] <> 0 then
        Inc(Result);
  end
  else
    for I := 0 to Items.Count - 1 do
      if FPushedButton[I] = Colon then
        Inc(Result);
end;

procedure TJvgAskListBox.SetSelectedItem(Value: Word);
begin
  if Value >= Items.Count then
    Exit;
  SendMessage(Handle, LB_SETCURSEL, Value, Longint(0));
end;

function TJvgAskListBox.GetButtons: TStrings;
begin
  Result := FButtons;
end;

procedure TJvgAskListBox.SetButtons(Value: TStrings);
begin
  if (Value <> nil) and (Value.Count <> 0) then
  begin
    FButtons.Assign(Value);
    RecalcHeights;
    Invalidate;
  end;
end;

function TJvgAskListBox.GetPushedButtonInLine(Index: Word): Integer;
begin
  if Index >= Items.Count then
    Result := -1
  else
    Result := FPushedButton[Index];
end;

function TJvgAskListBox.SetPushedButtonInLine(Index: Word; Value: Word): Boolean;
var
  R: TRect;
begin
  if (Index < Items.Count) and (Value in [0..2]) then
  begin
    Result := True;
    if FPushedButton[Index] = Value then
      Exit;
    FPushedButton[Index] := Value;
    SendMessage(Handle, LB_GETITEMRECT, Index, Longint(@R));
    R.Left := FSegment1Width;
    InvalidateRect(Handle, @R, True);
    //ButtonClicked;
    if (aloAutoScroll in Options) and (Value <> 0) then
      SendMessage(Handle, LB_SETCURSEL, FSelectedItem + 1, Longint(0));
  end
  else
    Result := False;
end;

procedure TJvgAskListBox.WMLButtonDown(var Msg: TWMLButtonDown);
var
  R: TRect;
  ItemN: Integer;
begin
  inherited;
  if aloIgnoreMouse in Options then
    Exit;
  MouseClickPoint.X := Msg.XPos;
  MouseClickPoint.Y := Msg.YPos;
  if Msg.XPos > Integer(FSegment1Width) then
  begin
    ItemN := ItemAtPos(SmallPointToPoint(Msg.Pos), True);
    SendMessage(Handle, LB_GETITEMRECT, ItemN, LPARAM(@R));
    Inc(R.Left, FSegment1Width);
    InvalidateRect(Handle, @R, False);
    //if (aloAutoScroll in Options)then SendMessage( Handle, LB_SETCURSEL, FSelectedItem+1, Longint(0));
  end;
end;

procedure TJvgAskListBox.WMSize(var Msg: TWMSize);
begin
  inherited;
  RecalcHeights;
end;

procedure TJvgAskListBox.ButtonClicked;
begin
  if Assigned(FOnButtonClicked) then
    FOnButtonClicked(Self);
end;

procedure TJvgAskListBox.RecalcHeights;
var
  I: Integer;
  R: TRect;
begin
  if Items.Count = 0 then
    Exit;

  SendMessage(Handle, LB_GETITEMRECT, Items.Count - 1, LPARAM(@R));
  FSegment1Width := Word((R.Right - R.Left) - (FButtonWidth + 1) *
    (Buttons.Count) - 1);

  Items.BeginUpdate;
  for I := 0 to Items.Count - 1 do
  begin
    Items.Insert(I, Items.Strings[I]);
    Items.Delete(I + 1);
  end;
  Items.EndUpdate;
end;

procedure TJvgAskListBox.SmthChanged(Sender: TObject);
begin
  FTextAlign_ := DT_WORDBREAK;
  FCaptionsAlign_ := DT_SINGLELINE;
  SetAlign(FTextAlign, FTextAlign_);
  SetAlign(FCaptionsAlign, FCaptionsAlign_);
  FCaptionsAlign_ := DT_CENTER or DT_VCENTER or DT_SINGLELINE;
  Invalidate;
end;

procedure TJvgAskListBox.InitState(var State: TOwnerDrawState; ByteState: Byte);
begin
  State := [];
  if ByteState and ODS_CHECKED <> 0 then
    Include(State, odChecked); //TOwnerDrawState
  if ByteState and ODS_COMBOBOXEDIT <> 0 then
    Include(State, odComboBoxEdit);
  if ByteState and ODS_DEFAULT <> 0 then
    Include(State, odDefault);
  if ByteState and ODS_DISABLED <> 0 then
    Include(State, odDisabled);
  if ByteState and ODS_FOCUS <> 0 then
    Include(State, odFocused);
  if ByteState and ODS_GRAYED <> 0 then
    Include(State, odGrayed);
  if ByteState and ODS_SELECTED <> 0 then
    Include(State, odSelected);
end;

procedure TJvgAskListBox.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = WallpaperImage) and (Operation = opRemove) then
    WallpaperImage := nil;
  if (AComponent = FGlyphs) and (Operation = opRemove) then
    Glyphs := nil;
end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.