jvgbutton.pas

East make Tray Icon in delphi

procedure TJvgButton.SmthChanged(Sender: TObject);
begin
  GetBitmaps;
  Invalidate;
end;

procedure TJvgButton.GetBitmap_(Index: Integer; var Bmp: TBitmap);
begin
  try
    if FDrawMode = dmUseImageList then
      FGlyphsList.GetBitmap(Index, Bmp)
    else
    begin
      if Assigned(Bmp) then
      begin
        Bmp.Free;
        Bmp := TBitmap.Create;
      end;
      Bmp.Assign(Glyph);
    end;
  except
    MessageDlg(RsEErrorDuringAccessGlyphsListOrGlyphP, mtError, [mbOk], 0);
    raise;
  end;
end;

procedure TJvgButton.OnBlinkTimer(Sender: TObject);
var
  ParentForm: TForm;
  I: Integer;

  procedure Blink(FreeButton: TJvgButton);
  begin
    with FreeButton do
    begin
      FNeedBlink := False;
      if FShowingAsPushedNow then
        with FChangeColorOnPush do
          if (boBlinkWhenPushed in Options) and (FromColor <> ToColor) then
          begin
            FNeedBlink := True;
            Repaint;
            Exit;
          end
          else
            Exit;
      if FMouseInControl then
        with FChangeColorOnActivate do
          if (boBlinkWhenActive in Options) and (FromColor <> ToColor) then
          begin
            FNeedBlink := True;
            Repaint;
            Exit;
          end
          else
            Exit;
      if not FMouseInControl then
        with FChangeColorOnActivate do
          if (boBlinkWhenInactive in Options) and (FromColor <> ToColor) then
          begin
            FNeedBlink := True;
            Repaint;
            Exit;
          end
          else
            Exit;
    end;
  end;

begin
  if (not TestMode) and (csDesigning in ComponentState) then
    Exit;
  ParentForm := GetParentForm(Self);
  for I := 0 to ParentForm.ComponentCount - 1 do
    if (ParentForm.Components[I] is TJvgButton) and
      (TJvgButton(ParentForm.Components[I]).BlinkTimer = FBlinkTimer) then
      with ParentForm.Components[I] as TJvgButton do
        Blink(TJvgButton(ParentForm.Components[I]));
end;

procedure TJvgButton.SetDrawMode(Value: TDrawMode);
begin
  if FDrawMode <> Value then
  begin
    FDrawMode := Value;
    GetBitmaps;
    Invalidate;
  end;
end;

procedure TJvgButton.SetGlyphsList(Value: TImageList);
begin
  if Assigned(Value) then
  begin
    FGlyphsList := Value;
    GetBitmaps;
    Invalidate;
  end;
end;

procedure TJvgButton.SetGlyph(Value: TBitmap);
begin
  if Assigned(FGlyph) then
  begin
    FGlyph.Free;
    FGlyph := TBitmap.Create;
  end;
  FGlyph.Assign(Value);
  GetBitmaps;
  Invalidate;
  AutoTransparentColor := AutoTransparentColor;
end;

procedure TJvgButton.SetNumGlyphs(Value: Integer);
begin
  if (Value >= 2) or (Value <= 4) then
    FNumGlyphs := Value;
end;

procedure TJvgButton.SetTransparentColor(Value: TColor);
begin
  if (FAutoTrColor <> ftcUser) or (FTransparentColor = Value) then
    Exit;
  FTransparentColor := Value;
  GetBitmaps;
  Invalidate;
end;

procedure TJvgButton.SetEnabled(Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    Repaint;
  end;
end;

procedure TJvgButton.SetShadowDepth(Value: Word);
begin
  if FShadowDepth <> Value then
  begin
    FShadowDepth := Value;
    if FDrawMode = dmAutoShadow then
    begin
      GetBitmaps;
      Invalidate;
    end;
  end;
end;

procedure TJvgButton.SetColorHighlight(Value: TColor);
begin
  if FColorHighlight <> Value then
  begin
    FColorHighlight := Value;
    if FDrawMode <> dmUseImageList then
    begin
      GetBitmaps;
      Invalidate;
    end;
  end;
end;

procedure TJvgButton.SetColorShadow(Value: TColor);
begin
  if FColorShadow <> Value then
  begin
    FColorShadow := Value;
    if FDrawMode <> dmUseImageList then
    begin
      GetBitmaps;
      Invalidate;
    end;
  end;
end;

procedure TJvgButton.SetColorDarkShadow(Value: TColor);
begin
  if FColorDarkShadow <> Value then
  begin
    FColorDarkShadow := Value;
    if FDrawMode <> dmUseImageList then
    begin
      GetBitmaps;
      Invalidate;
    end;
  end;
end;

procedure TJvgButton.SetDisabledMaskColor(Value: TColor);
begin
  if FDisabledMaskColor <> Value then
  begin
    FDisabledMaskColor := Value;
    if FDrawMode <> dmUseImageList then
    begin
      GetBitmaps;
      Invalidate;
    end;
  end;
end;

procedure TJvgButton.SetOptions(Value: TglButtonOptions);
begin
  if FOptions <> Value then
  begin
    FOptions := Value;
    if FDrawMode <> dmUseImageList then
    begin
      GetBitmaps;
      Invalidate;
    end;
  end;
end;

procedure TJvgButton.SetAutoTrColor(Value: TglAutoTransparentColor);
var
  X, Y: Integer;
  TmpBmp_: TBitmap;
begin
  FAutoTrColor := Value;
  TmpBmp_ := nil;
  if {(FAutoTrColor=ftcUser)or}(FGlyph.Width = 0) or (FGlyph.Height = 0) then
    Exit;
  try
    with FGlyph do
      case FAutoTrColor of
        ftcLeftTopPixel:
          begin
            X := 0;
            Y := 0;
          end;
        ftcLeftBottomPixel:
          begin
            X := 0;
            Y := Height - 1;
          end;
        ftcRightTopPixel:
          begin
            X := Width - 1;
            Y := 0;
          end;
        ftcRightBottomPixel:
          begin
            X := Width - 1;
            Y := Height - 1;
          end;
      else
        Exit;
      end;
    TmpBmp_ := TBitmap.Create;
    TmpBmp_.Assign(FGlyph);
    FTransparentColor := GetPixel(TmpBmp_.Canvas.Handle, X, Y);
  finally
    TmpBmp_.Free;
    GetBitmaps;
    Invalidate;
  end;
end;

procedure TJvgButton.SetBlinkTimer(Value: TTimer);
var
  ParentForm: TForm;
  I: Integer;
  p1, p2: TNotifyEvent;
  Timer: TTimer;
begin
  if FBlinkTimer = Value then
    Exit;
  if Assigned(FBlinkTimer) then
  begin
    p1 := FBlinkTimer.OnTimer;
    p2 := OnBlinkTimer;
    if @FBlinkTimer.OnTimer = @p2 then //...points at me
    begin
      ParentForm := GetParentForm(Self);
      for I := 0 to ParentForm.ComponentCount - 1 do
        if (ParentForm.Components[I] is TJvgButton) and
          (TJvgButton(ParentForm.Components[I]) <> Self) and
          (TJvgButton(ParentForm.Components[I]).BlinkTimer = FBlinkTimer) then
        begin
          Timer := FBlinkTimer;
          FBlinkTimer := nil;
          Timer.OnTimer := TJvgButton(ParentForm.Components[I]).OnBlinkTimer;
          Break;
        end;
      if Assigned(FBlinkTimer) and (@FBlinkTimer.OnTimer = @p2) then
        FBlinkTimer.OnTimer := nil;
    end;
  end
  else
    FBlinkTimer := nil;

  FBlinkTimer := Value;
  if Assigned(FBlinkTimer) then
    FBlinkTimer.OnTimer := OnBlinkTimer;
end;

function TJvgButton.GetBlinkTimer: TTimer;
begin
  Result := nil;
  try
    if Assigned(FBlinkTimer) then
      if Owner.Components[FBlinkTimer.ComponentIndex] = FBlinkTimer then
        Result := FBlinkTimer;
  except
  end;
end;

procedure TJvgButton.SetTestMode(Value: Boolean);
var
  ParentForm: TForm;
  I: Integer;
begin
  ParentForm := GetParentForm(Self);
  for I := 0 to ParentForm.ComponentCount - 1 do
    if (ParentForm.Components[I] is TJvgButton) then
      TJvgButton(ParentForm.Components[I]).FTestMode := Value;
end;

//=== { TJvgGlyphsIndexes } ==================================================

constructor TJvgGlyphsIndexes.Create;
begin
  inherited Create;
  FInactive := 0;
  FPushed := 1;
  FActive := 2;
  FDisabled := -1;
  FMask := 3;
end;

procedure TJvgGlyphsIndexes.DoChanged;
begin
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

procedure TJvgGlyphsIndexes.SetInactive(Value: Integer);
begin
  FInactive := Value;
  DoChanged;
end;

procedure TJvgGlyphsIndexes.SetPushed(Value: Integer);
begin
  FPushed := Value;
  DoChanged;
end;

procedure TJvgGlyphsIndexes.SetActive(Value: Integer);
begin
  FActive := Value;
  DoChanged;
end;

procedure TJvgGlyphsIndexes.SetDisabled(Value: Integer);
begin
  FDisabled := Value;
  DoChanged;
end;

procedure TJvgGlyphsIndexes.SetMask(Value: Integer);
begin
  FMask := Value;
  DoChanged;
end;

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

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

end.