jvgpage.pas

East make Tray Icon in delphi

        ;
    end;
end;

procedure TJvgPageControl.GlyphsListChanged(Sender: TObject);
begin
  if HandleAllocated then
    SendMessage(Handle, TCM_SETIMAGELIST, 0, Longint(TImageList(Sender).Handle));
end;

procedure TJvgPageControl.DrawItem(lpDrawItemStr: PDrawItemStruct);
var
  FontColor: TColor;
begin
  if FSuppressDraw then
    Exit;
  with lpDrawItemStr^ do
    if CtlType = ODT_TAB then
    begin
      //fLoaded:=True; Options:=NewOptions;
      FDrawTabStr.lpDrawItemStr := lpDrawItemStr;
      FDrawTabStr.Caption := Tabs[ItemID];

      if GlyphIndex[ItemID] <> -1 then
      begin
        FGlyphs.GetBitmap(GlyphIndex[ItemID], FGlyphTmpBitmap);
        FDrawTabStr.Glyph := FGlyphTmpBitmap;
      end
      else
        FDrawTabStr.Glyph := nil;

      if (itemState and ODS_DISABLED) <> 0 then
      begin
        FDrawTabStr.BoxStyle := FTabStyle;
        FDrawTabStr.Font_.Assign(FFontNormal);
      end
      else
      if (itemState and ODS_SELECTED) <> 0 then
      begin
        FDrawTabStr.BoxStyle := FTabSelectedStyle;
        FDrawTabStr.Font_.Assign(FFontSelected);
      end
      else
      begin
        FDrawTabStr.BoxStyle := FTabStyle;
        FDrawTabStr.Font_.Assign(FFontNormal);
      end;

      if Assigned(OnGetItemFontColor) then
      begin
        OnGetItemFontColor(Self, ItemID, FontColor);
        FDrawTabStr.Font_.Color := FontColor;
      end;

      FDrawTabStr.GlyphOption := FDrawGlyphsOption;
      FDrawTabStr.Wallpaper := FWallpaper;
      FDrawTabStr.ClientR := ClientRect;
      FDrawTabStr.TabsCount := Tabs.Count;
      FDrawTabStr.fButton := LookLikeButtons;
      FDrawTabStr.Position := TabsPosition;
      FDrawTabStr.Options := Options;
      FDrawTabStr.FontDirection := FontDirection;

      if Assigned(OnGetGradientColors) then
        OnGetGradientColors(Self, ItemID, FDrawTabStr.Gradient);

      if Assigned(OnGetItemColor) then
        OnGetItemColor(Self, ItemID, FDrawTabStr.BackgrColor_)
      else
      if FTabColors[ItemID] <> -1 then
        FDrawTabStr.BackgrColor_ := FTabColors[ItemID]
      else
        FDrawTabStr.BackgrColor_ := FDrawTabStr.BoxStyle.BackgrColor;

      if Style = tsFlatButtons then
        FDrawTabStr.FlatButtons := True;

      DrawOwnTab(FDrawTabStr); //FWallpaper.IncludeBevels
    end;
end;

procedure TJvgPageControl.CMFontChanged(var Msg: TMessage);
begin
  inherited;
  if ftoInheriteTabFonts in Options then
  begin
    FTabStyle.Font.Assign(inherited Font);
    FTabSelectedStyle.Font.Assign(inherited Font);
    // Disabled.Assign(inherited Font);
    RemakeFonts;
  end;
end;

procedure TJvgPageControl.RemakeFonts;
const
  RadianEscapments: array [TglLabelDir] of Integer =
    (0, -1800, -900, 900);
begin
  if csReading in ComponentState then
    Exit;
  if FNotFirst then
    DeleteObject(FTabStyle.Font.Handle);
  FNotFirst := True;

  FFontNormal.Handle := CreateRotatedFont(FTabStyle.Font,
    RadianEscapments[FFontDirection]);
  FFontNormal.Color := FTabStyle.Font.Color;
  FFontSelected.Handle := CreateRotatedFont(FTabSelectedStyle.Font,
    RadianEscapments[FFontDirection]);
  FFontSelected.Color := FTabSelectedStyle.Font.Color;
end;

procedure TJvgPageControl.SetGlyphs(Value: TImageList);
var
  I: Integer;
  B: Boolean;
begin
  if Assigned(FGlyphs) then
    FGlyphs.UnregisterChanges(FGlyphsChangeLink);
  FGlyphs := Value;
  if Assigned(FGlyphs) then
  begin
    FGlyphs.RegisterChanges(FGlyphsChangeLink);
    SendMessage(Handle, TCM_SETIMAGELIST, 0, Longint(FGlyphs.Handle));
    B := True;
    for I := 0 to Min(Tabs.Count - 1, FGlyphs.Count - 1) do
      if GlyphIndex[I] <> -1 then
      begin
        B := False;
        Break;
      end;
    if B then
      SetSingleGlyph(FSingleGlyph);
  end
  else
    SendMessage(Handle, TCM_SETIMAGELIST, 0, Longint(0));
end;

procedure TJvgPageControl.SetGlyphIndex(Index: Integer; ImgIndex: Integer);
var
  R: TRect;
  Item: TTCItem;
begin
  Item.iImage := ImgIndex;
  Item.mask := TCIF_IMAGE;
  SendMessage(Handle, TCM_SETITEM, Index, Longint(@Item));
  SendMessage(Handle, TCM_GETITEMRECT, Index, Longint(@R));
  InvalidateRect(Handle, @R, True);
end;

function TJvgPageControl.GetGlyphIndex(Index: Integer): Integer;
var
  ImgItem: TTCItem;
begin
  if Assigned(FGlyphs) then
  begin
    ImgItem.mask := TCIF_IMAGE;
    SendMessage(Handle, TCM_GETITEM, Index, Longint(@ImgItem));
    Result := ImgItem.iImage;
  end
  else
    Result := -1;
end;

procedure TJvgPageControl.SetSingleGlyph(Value: Boolean);
var
  I: Integer;
begin
  FSingleGlyph := Value;
  if (Tabs = nil) or (FGlyphs = nil) then
    Exit;
  if FSingleGlyph then
    for I := 0 to Tabs.Count - 1 do
      GlyphIndex[I] := 0
  else
    for I := 0 to Tabs.Count - 1 do
      if FGlyphs.Count >= I then
        GlyphIndex[I] := I
      else
        Break;
end;

procedure TJvgPageControl.SetDrawGlyphsOption(Value: TglWallpaperOption);
begin
  if FDrawGlyphsOption <> Value then
  begin
    FDrawGlyphsOption := Value;
    Invalidate;
  end;
end;

procedure TJvgPageControl.SetLookLikeButtons(Value: Boolean);
begin
  if FLookLikeButtons <> Value then
  begin
    FLookLikeButtons := Value;
    RecreateWnd;
  end;
end;

procedure TJvgPageControl.SetTabsPosition(Value: TglSide);
begin
  if FTabsPosition <> Value then
  begin
    FTabsPosition := Value;
    RecreateWnd;
    if (ftoAutoFontDirection in FOptions) and not (csLoading in ComponentState) then
      FontDirection := FontDirs[TabsPosition];
  end;
end;

procedure TJvgPageControl.SetOptions(Value: TglTabOptions);
begin
  if FOptions <> Value then
  begin
    FOptions := Value;
    if ftoAutoFontDirection in FOptions then
      FontDirection := FontDirs[TabsPosition];
    Invalidate;
  end;
end;

procedure TJvgPageControl.SetFontDirection(Value: TglLabelDir);
begin
  if FFontDirection <> Value then
  begin
    FFontDirection := Value;
    RemakeFonts;
    Invalidate;
  end;
end;

function TJvgPageControl.GetFont: TFont;
begin
  Result := inherited Font;
end;

procedure TJvgPageControl.SetFont(Value: TFont);
begin
  inherited Font := Value;
  if ftoInheriteTabFonts in Options then
  begin
    FTabStyle.Font.Assign(inherited Font);
    FTabSelectedStyle.Font.Assign(inherited Font);
  end;
end;

function TJvgPageControl.GetTabColor(Index: Integer): TColor;
begin
  if Index < 100 then
    Result := FTabColors[Index]
  else
    Result := -1;
end;

procedure TJvgPageControl.SetTabColor(Index: Integer; Value: TColor);
var
  TCItem: TTCItem;
begin
  if (Index < 100) and (TabColor[Index] <> Value) then
    FTabColors[Index] := Value
  else
    Exit;
  if not FSuppressDraw then
  begin
    //  Repaint;
    TCItem.mask := TCIF_TEXT;
    TCItem.pszText := PChar(Tabs[Index]);
    SendMessage(Handle, TCM_SETITEM, Index, Longint(@TCItem));
  end;
end;

procedure TJvgPageControl.SetTabStyle(const Value: TJvgTabStyle);
begin
  FTabStyle := Value;
  RemakeFonts;
end;

procedure TJvgPageControl.SetTabSelectedStyle(const Value: TJvgTabStyle);
begin
  FTabSelectedStyle := Value;
  RemakeFonts;
end;

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

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

end.