cxbuttons.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,149 行 · 第 1/5 页

begin
  if ALookAndFeel.SkinPainter <> nil then
    Result := ALookAndFeel.SkinPainter
  else
  begin
    Result := ALookAndFeel.Painter;
    if Result.LookAndFeelStyle = lfsOffice11 then
      if AreVisualStylesAvailable(totButton) then
        Result := TcxWinXPLookAndFeelPainter
      else
        Result := TcxStandardLookAndFeelPainter;
  end;      
end;

{ TcxButtonColors }

constructor TcxButtonColors.Create(AOwner: TcxCustomButton);
var
  AState: TcxButtonAssignedColor;
begin
  inherited Create;
  FButton := AOwner;
  for AState := Low(AState) to High(AState) do
    FColors[AState] := clDefault;
end;

function TcxButtonColors.GetColor(const Index: Integer): TColor;
begin
  Result := FColors[TcxButtonAssignedColor(Index)];
end;

function TcxButtonColors.IsColorStored(const Index: Integer): Boolean;
begin
  Result := TcxButtonAssignedColor(Index) in FAssignedColors;
end;

procedure TcxButtonColors.SetAssignedColors(
  Value: TcxButtonAssignedColors);
var
  AState: TcxButtonAssignedColor;
begin
  if (FAssignedColors <> Value) and (csDesigning in FButton.ComponentState) then
  begin
    for AState := Low(AState) to High(AState) do
      if not (AState in Value) then
        FColors[AState] := clDefault
      else
        if FColors[AState] = clDefault then Exclude(Value, AState);
    FAssignedColors := Value;
    FButton.Invalidate;
  end;
end;

procedure TcxButtonColors.SetColor(const Index: Integer;
  const Value: TColor);
begin
  if (Value = clNone) or (Value = clDefault) then
  begin
    FColors[TcxButtonAssignedColor(Index)] := clDefault;
    Exclude(FAssignedColors, TcxButtonAssignedColor(Index));
    FButton.Invalidate;
  end
  else if GetColor(Index) <> Value then
  begin
    FColors[TcxButtonAssignedColor(Index)] := Value;
    Include(FAssignedColors, TcxButtonAssignedColor(Index));
    FButton.Invalidate;
  end;
end;

function TcxButtonColors.TcxButtonState2TcxButtonAssignedColor(AState: TcxButtonState; ATextColor: Boolean): TcxButtonAssignedColor;
begin
  if ATextColor then
    Result := cxbcNormalText
  else
    Result := cxbcNormal;
  case AState of
    cxbsDefault:
      if ATextColor then
        Result := cxbcDefaultText
      else
        Result := cxbcDefault;
    cxbsHot:
      if ATextColor then
        Result := cxbcHotText
      else
        Result := cxbcHot;
    cxbsPressed:
      if ATextColor then
        Result := cxbcPressedText
      else
        Result := cxbcPressed;
    cxbsDisabled:
      if ATextColor then
        Result := cxbcDisabledText
      else
        Result := cxbcDisabled;
  end;
end;

function TcxButtonColors.GetColorByState(const AState: TcxButtonState): TColor;
var
  AButtonColor: TcxButtonAssignedColor;
begin
  AButtonColor := TcxButtonState2TcxButtonAssignedColor(AState, False);
  if AButtonColor in AssignedColors then
    Result := FColors[AButtonColor]
  else
    if AButtonColor = cxbcNormal then
      Result := FColors[cxbcDefault]
    else
      Result := FColors[cxbcNormal];
end;

function TcxButtonColors.GetTextColorByState(const AState: TcxButtonState): TColor;
var
  AButtonColor: TcxButtonAssignedColor;
begin
  AButtonColor := TcxButtonState2TcxButtonAssignedColor(AState, True);
  if AButtonColor in AssignedColors then
    Result := FColors[AButtonColor]
  else
    Result := clDefault;
end;

procedure TcxButtonColors.Assign(Source: TPersistent);
begin
  if Source is TcxButtonColors then
    with TcxButtonColors(Source) do
    begin
      Self.FColors := FColors;
      Self.FAssignedColors := FAssignedColors;
      Self.FButton.Invalidate;
    end
    else
      inherited Assign(Source);
end;

{ TcxGlyphList }

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

destructor TcxGlyphList.Destroy;
begin
  FreeAndNil(FUsed);
  inherited Destroy;
end;

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

function TcxGlyphList.Add(AImage, AMask: TBitmap): Integer;
begin
  Result := AllocateIndex(AImage);
  Replace(Result, AImage, AMask);
  Inc(FCount);
end;

function TcxGlyphList.AddMasked(AImage: TBitmap; AMaskColor: TColor): Integer;
begin
  Result := AllocateIndex(AImage);
  ReplaceMasked(Result, AImage, AMaskColor);
  Inc(FCount);
end;

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

type
  { TcxGlyphCache }

  TcxGlyphCache = class
  private
    FGlyphLists: TList;
  public
    constructor Create;
    destructor Destroy; override;
    function GetList(AWidth, AHeight: Integer): TcxGlyphList;
    procedure ReturnList(AList: TcxGlyphList);
    function Empty: Boolean;
  end;

{ TcxGlyphCache }

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

destructor TcxGlyphCache.Destroy;
begin
  FreeAndNil(FGlyphLists);
  inherited Destroy;
end;

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

procedure TcxGlyphCache.ReturnList(AList: TcxGlyphList);
begin
  if AList = nil then Exit;
  if AList.Count = 0 then
  begin
    FGlyphLists.Remove(AList);
    AList.Free;
  end;
end;

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

var
  GlyphCache: TcxGlyphCache = nil;

{ TcxImageInfo }

constructor TcxImageInfo.Create;
begin
  inherited Create;
  FGlyph := TBitmap.Create;
  FGlyph.OnChange := OnChange;
  FImageIndex := -1;
end;

destructor TcxImageInfo.Destroy;
begin
  FreeAndNil(FGlyph);
  inherited;
end;

function TcxImageInfo.GetImageSize: TSize;
begin
  if not IsImageAssigned then
    Result := cxNullSize
  else
    if IsGlyphAssigned(Glyph) then
    begin
      if (Glyph.Width = 0) or (Glyph.Height = 0) then
        Glyph.Handle; //HandleNeeded
      Result := Size(Glyph.Width, Glyph.Height)
    end
    else
      Result := Size(Images.Width, Images.Height);
end;

function TcxImageInfo.IsImageAssigned: Boolean;
begin
  Result := IsGlyphAssigned(Glyph) or cxGraphics.IsImageAssigned(Images, ImageIndex);
end;

procedure TcxImageInfo.GlyphChanged;
begin
  CallNotify(OnChange, nil);
end;

function TcxImageInfo.GetOnChange: TNotifyEvent;
begin
  Result := FGlyph.OnChange;
end;

procedure TcxImageInfo.SetGlyph(Value: TBitmap);
begin
  FGlyph.Assign(Value);
end;

procedure TcxImageInfo.SetImages(Value: TCustomImageList);
begin
  if Images <> Value then
  begin
    FImages := Value;
    if not IsGlyphAssigned(Glyph) and (ImageIndex <> -1) then
      GlyphChanged;
  end;
end;

procedure TcxImageInfo.SetImageIndex(Value: Integer);
begin
  if ImageIndex <> Value then
  begin
    FImageIndex := Value;
    if not IsGlyphAssigned(Glyph) and (Images <> nil) then
      GlyphChanged;
  end;
end;

procedure TcxImageInfo.SetOnChange(Value: TNotifyEvent);
begin
  FGlyph.OnChange := Value;
end;

{ TcxButtonGlyph }

constructor TcxButtonGlyph.Create;
var
  I: TButtonState;
begin
  inherited Create;
  FImageInfo := TcxImageInfo.Create;
  FImageInfo.OnChange := GlyphChanged;
  FNumGlyphs := 1;
  for I := Low(I) to High(I) do
    FIndexs[I] := -1;
  if GlyphCache = nil then GlyphCache := TcxGlyphCache.Create;
end;

destructor TcxButtonGlyph.Destroy;
begin
  FreeAndNil(FImageInfo);
  Invalidate;
  if Assigned(GlyphCache) and GlyphCache.Empty then
    FreeAndNil(GlyphCache);
  inherited Destroy;
end;

procedure TcxButtonGlyph.Invalidate;
var
  I: TButtonState;
begin
  for I := Low(I) to High(I) do
  begin
    if FIndexs[I] <> -1 then FGlyphList.Delete(FIndexs[I]);
    FIndexs[I] := -1;
  end;
  GlyphCache.ReturnList(FGlyphList);
  FGlyphList := nil;
end;

function TcxButtonGlyph.GetImageSize: TSize;
begin
  Result := ImageInfo.GetImageSize;
  Result.cx := Result.cx div FNumGlyphs;
end;

function TcxButtonGlyph.GetTransparentColor: TColor;
begin
  Result := Glyph.TransparentColor;
end;

procedure TcxButtonGlyph.GlyphChanged(Sender: TObject);
begin
  Invalidate;
  if Assigned(FOnChange) then FOnChange(Self);
end;

function TcxButtonGlyph.GetGlyph: TBitmap;
begin
  Result := ImageInfo.Glyph;
end;

function TcxButtonGlyph.GetImageList: TCustomImageList;
begin
  Result := ImageInfo.Images;
end;

function TcxButtonGlyph.GetImageIndex: Integer;
begin
  Result := ImageInfo.ImageIndex;
end;

procedure TcxButtonGlyph.SetGlyph(Value: TBitmap);
var
  ANumGlyphs: Integer;
begin
  ANumGlyphs := 1;
  ImageInfo.Glyph := Value;
  if (Value <> nil) and (Value.Height > 0) then
  begin
    if Value.Width mod Value.Height = 0 then
    begin
      ANumGlyphs := Value.Width div Value.Height;
      if ANumGlyphs > 4 then ANumGlyphs := 1;
    end;
  end;
  NumGlyphs := ANumGlyphs;
end;

procedure TcxButtonGlyph.SetImageList(Value: TCustomImageList);
begin
  ImageInfo.Images := Value;
end;

procedure TcxButtonGlyph.SetImageIndex(Value: Integer);
begin
  ImageInfo.ImageIndex := Value;
end;

procedure TcxButtonGlyph.SetNumGlyphs(Value: TNumGlyphs);
begin
  Value := Min(Max(Value, 1), 4);
  if Value <> FNumGlyphs then
  begin
    FNumGlyphs := Value;
    GlyphChanged(Glyph);
  end;
end;

function TcxButtonGlyph.CreateButtonGlyph(AState: TcxButtonState): Integer;