tntjvspeedbutton.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

        inherited;
        Msg.DC := DC;
      finally
        RestoreDC(Msg.DC, Index);
      end;
      BitBlt(Msg.DC, 0, 0, Width, Height, MemDC, 0, 0, SRCCOPY);
    finally
      SelectObject(MemDC, SaveBitmap);
      DeleteDC(MemDC);
      DeleteObject(MemBitmap);
    end;
  end;
end;

procedure TTntJvCustomSpeedButton0.WMRButtonDown(var Msg: TWMRButtonDown);
begin
  inherited;
  UpdateTracking;
end;

procedure TTntJvCustomSpeedButton0.WMRButtonUp(var Msg: TWMRButtonUp);
begin
  inherited;
  UpdateTracking;
end;

{$ENDIF VCL}

//=== { TTntJvCustomSpeedButton } ============================================

function TTntJvCustomSpeedButton.GetCaptionEditor: TUnicodeLinesEditor;
begin
  Result := FCaptionEditor;
  FCaptionEditor.SetText (Caption);
end;

procedure TTntJvCustomSpeedButton.SetCaptionEditor(
  const Value: TUnicodeLinesEditor);
begin
  FCaptionEditor.Assign (Value);
  Caption := FCaptionEditor.GetText;
end;

constructor TTntJvCustomSpeedButton.Create(AOwner: TComponent);
begin
  inherited;
  if  csDesigning in ComponentState
  then  FCaptionEditor := TUnicodeLinesEditor.Create;
end;

destructor TTntJvCustomSpeedButton.Destroy;
begin
  if  csDesigning in ComponentState
  then  FreeAndNil(FCaptionEditor);
  inherited;
end;

//=== { TJvGlyphCache } ======================================================

constructor TJvGlyphCache.Create;
begin
  inherited Create;
  FGlyphLists := TList.Create;
end;

destructor TJvGlyphCache.Destroy;
begin
  FGlyphLists.Free;
  inherited Destroy;
end;

function TJvGlyphCache.Empty: Boolean;
begin
  Result := FGlyphLists.Count = 0;
end;

function TJvGlyphCache.GetList(AWidth, AHeight: Integer): TJvGlyphList;
var
  I: Integer;
begin
  for I := FGlyphLists.Count - 1 downto 0 do
  begin
    Result := TJvGlyphList(FGlyphLists[I]);
    with Result do
      if (AWidth = Width) and (AHeight = Height) then
        Exit;
  end;
  Result := TJvGlyphList.CreateSize(AWidth, AHeight);
  FGlyphLists.Add(Result);
end;

procedure TJvGlyphCache.ReturnList(List: TJvGlyphList);
begin
  if List = nil then
    Exit;
  if List.Count = 0 then
  begin
    FGlyphLists.Remove(List);
    List.Free;
  end;
end;

//=== { TJvGlyphList } =======================================================

function TJvGlyphList.Add(Image, Mask: TBitmap): Integer;
begin
  Result := AllocateIndex;
  Replace(Result, Image, Mask);
  Inc(FCount);
end;

function TJvGlyphList.AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
begin
  Result := AllocateIndex;
  ReplaceMasked(Result, Image, MaskColor);
  Inc(FCount);
end;

function TJvGlyphList.AllocateIndex: Integer;
begin
  Result := FUsed.OpenBit;
  if Result >= FUsed.Size then
  begin
    Result := inherited Add(nil, nil);
    FUsed.Size := Result + 1;
  end;
  FUsed[Result] := True;
end;

constructor TJvGlyphList.CreateSize(AWidth, AHeight: Integer);
begin
  inherited CreateSize(AWidth, AHeight);
  FUsed := TBits.Create;
end;

procedure TJvGlyphList.Delete(Index: Integer);
begin
  if FUsed[Index] then
  begin
    Dec(FCount);
    FUsed[Index] := False;
  end;
end;

destructor TJvGlyphList.Destroy;
begin
  FUsed.Free;
  inherited Destroy;
end;

//=== { TTntJvImageSpeedButton } ================================================

procedure TTntJvImageSpeedButton.ActionChange(Sender: TObject;
  CheckDefaults: Boolean);
begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if (not CheckDefaults or (Self.Images = nil)) and (ActionList <> nil) then
        Self.Images := TCustomImageList(ActionList.Images);
      if not CheckDefaults or (Self.ImageIndex = -1) then
        Self.ImageIndex := ImageIndex;
    end;
end;

constructor TTntJvImageSpeedButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  FImageIndex := -1;
end;

destructor TTntJvImageSpeedButton.Destroy;
begin
  FreeAndNil(FImageChangeLink);
  inherited Destroy;
end;

function TTntJvImageSpeedButton.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TTntJvImageSpeedButtonActionLink;
end;

procedure TTntJvImageSpeedButton.ImageListChange(Sender: TObject);
begin
  InvalidateImage;
end;

procedure TTntJvImageSpeedButton.InvalidateImage;
begin
  Invalidate;
end;

function TTntJvImageSpeedButton.IsImageVisible: Boolean;
begin
  Result := {FImageVisible and} Assigned(FImages) and (FImageIndex >= 0)
end;

procedure TTntJvImageSpeedButton.PaintImage(Canvas: TCanvas; ARect: TRect;
  const Offset: TPoint; AState: TJvButtonState; DrawMark: Boolean);
var
  LImageIndex: TImageIndex;
begin
  if (MouseOver or FDragging) and HotTrack and (HotTrackImageIndex <> -1) then
    LImageIndex := HotTrackImageIndex
  else
    LImageIndex := ImageIndex;
  FGlyph.DrawEx(Canvas, ARect, Offset, Caption, FLayout,
    FMargin, FSpacing, DrawMark, Images, LImageIndex, AState, DrawTextBiDiModeFlags(Alignments[Alignment]));
end;

procedure TTntJvImageSpeedButton.SetHotTrackImageIndex(
  const Value: TImageIndex);
begin
  if FHotTrackImageIndex <> Value then
  begin
    FHotTrackImageIndex := Value;
    { Only invalidate when hot }
    if (MouseOver or FDragging) and HotTrack then
      InvalidateImage;
  end;
end;

procedure TTntJvImageSpeedButton.SetImageIndex(const Value: TImageIndex);
begin
  if FImageIndex <> Value then
  begin
    FImageIndex := Value;
    { Only invalidate when not hot }
    if not (MouseOver or FDragging) or not HotTrack then
      InvalidateImage;
  end;
end;

procedure TTntJvImageSpeedButton.SetImages(const Value: TCustomImageList);
begin
  if FImages <> nil then
    FImages.UnRegisterChanges(FImageChangeLink);
  FImages := Value;
  if FImages <> nil then
  begin
    FImages.RegisterChanges(FImageChangeLink);
    FImages.FreeNotification(Self);
  end
  else
    SetImageIndex(-1);
  InvalidateImage;
end;

//=== { TTntJvImageSpeedButtonActionLink } ======================================

procedure TTntJvImageSpeedButtonActionLink.AssignClient(AClient: TObject);
begin
  inherited AssignClient(AClient);
  FClient := AClient as TTntJvImageSpeedButton;
end;

function TTntJvImageSpeedButtonActionLink.IsCheckedLinked: Boolean;
begin
  Result := inherited IsCheckedLinked and (FClient.GroupIndex <> 0) and
    FClient.AllowAllUp and (FClient.Down = (Action as TCustomAction).Checked);
end;

{$IFDEF COMPILER6_UP}
{$IFDEF VCL}

function TTntJvImageSpeedButtonActionLink.IsGroupIndexLinked: Boolean;
begin
  { (rb) This will fail in D7 due to a bug in TCustomAction.SetGroupIndex }
  Result := (FClient is TTntJvCustomSpeedButton0) and
    (FClient.GroupIndex = (Action as TCustomAction).GroupIndex);
end;

procedure TTntJvImageSpeedButtonActionLink.SetGroupIndex(Value: Integer);
begin
  if IsGroupIndexLinked then
    FClient.GroupIndex := Value;
end;

{$ENDIF VCL}
{$ENDIF COMPILER6_UP}

function TTntJvImageSpeedButtonActionLink.IsImageIndexLinked: Boolean;
begin
  Result := inherited IsImageIndexLinked and
    (FClient.ImageIndex = (Action as TCustomAction).ImageIndex);
end;

procedure TTntJvImageSpeedButtonActionLink.SetChecked(Value: Boolean);
begin
  if IsCheckedLinked then
    FClient.Down := Value;
end;

procedure TTntJvImageSpeedButtonActionLink.SetImageIndex(Value: Integer);
begin
  if IsImageIndexLinked then
    FClient.ImageIndex := Value;
end;

//=== { TTntJvSpeedButton } =====================================================

procedure TTntJvSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);

  procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
  begin
    with Glyph do
    begin
      Width := ImageList.Width;
      Height := ImageList.Height;
      Canvas.Brush.Color := clFuchsia;
      Canvas.FillRect(Rect(0, 0, Width, Height));
      ImageList.Draw(Canvas, 0, 0, Index);
      TransparentColor := clFuchsia;
    end;
  end;

begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if CheckDefaults or (Self.GroupIndex = 0) then
        Self.GroupIndex := GroupIndex;
      { Copy image from action's imagelist }
      if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
        (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
        CopyImage(TCustomImageList(ActionList.Images), ImageIndex);
    end;
end;

constructor TTntJvSpeedButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGlyph.OnChange := GlyphChanged;
  FHotTrackGlyph := TTntJvxButtonGlyph.Create;
  FHotTrackGlyph.OnChange := HotTrackGlyphChanged;
end;

destructor TTntJvSpeedButton.Destroy;
begin
  FHotTrackGlyph.Free;
  inherited Destroy;
end;

function TTntJvSpeedButton.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TTntJvSpeedButtonActionLink;
end;

function TTntJvSpeedButton.GetGlyph: TBitmap;
begin
  Result := FGlyph.Glyph;
end;

function TTntJvSpeedButton.GetHotTrackGlyph: TBitmap;
begin
  Result := FHotTrackGlyph.Glyph;
end;

function TTntJvSpeedButton.GetNumGlyphs: TJvNumGlyphs;
begin
  Result := FGlyph.NumGlyphs;
end;

{$IFDEF VCL}
function TTntJvSpeedButton.GetPalette: HPALETTE;
begin
  Result := Glyph.Palette;
end;
{$ENDIF VCL}

procedure TTntJvSpeedButton.GlyphChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TTntJvSpeedButton.HotTrackGlyphChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TTntJvSpeedButton.PaintImage(Canvas: TCanvas; ARect: TRect; const Offset: TPoint;
  AState: TJvButtonState; DrawMark: Boolean);
begin
  if (MouseOver or FDragging) and HotTrack and not HotTrackGlyph.Empty then
  begin
    SyncHotGlyph;
    FHotTrackGlyph.Draw(Canvas, ARect, Offset, Caption, FLayout,
      FMargin, FSpacing, DrawMark, AState, DrawTextBiDiModeFlags(Alignments[Alignment]));
  end
  else
    FGlyph.Draw(Canvas, ARect, Offset, Caption, FLayout,
      FMargin, FSpacing, DrawMark, AState, DrawTextBiDiModeFlags(Alignments[Alignment]));
end;

procedure TTntJvSpeedButton.SetGlyph(Value: TBitmap);
begin
  FGlyph.Glyph := Value;
  Invalidate;
end;

procedure TTntJvSpeedButton.SetHotTrackGlyph(const Value: TBitmap);
begin
  FHotTrackGlyph.Glyph := Value;
  Invalidate;
end;

procedure TTntJvSpeedButton.SetNumGlyphs(Value: TJvNumGlyphs);
begin
  if Value < 0 then
    Value := 1
  else
  if Value > Ord(High(TJvButtonState)) + 1 then
    Value := Ord(High(TJvButtonState)) + 1;
  if Value <> FGlyph.NumGlyphs then
  begin
    FGlyph.NumGlyphs := Value;
    Invalidate;
  end;
end;

procedure TTntJvSpeedButton.SyncHotGlyph;
begin
  with FHotTrackGlyph do
  begin
    OnChange := nil;
    try
      Alignment := FGlyph.Alignment;
      GrayNewStyle := FGlyph.GrayNewStyle;
      NumGlyphs := FGlyph.NumGlyphs;
      WordWrap := FGlyph.WordWrap;
    finally
      OnChange := HotTrackGlyphChanged;
    end;
  end;
end;

//=== { TTntJvSpeedButtonActionLink } ===========================================

procedure TTntJvSpeedButtonActionLink.AssignClient(AClient: TObject);
begin
  inherited AssignClient(AClient);
  FClient := AClient as TTntJvSpeedButton;
end;

function TTntJvSpeedButtonActionLink.IsCheckedLinked: Boolean;
begin
  Result := inherit