myautobtn.pas

自动适应简繁体的TBitbtn按钮,并有类似XP风格的外观

{ TMyAutoBitBtn }

constructor TMyAutoBitBtn.Create(AOwner: TComponent);
begin
  FGlyph := TButtonGlyph.Create;
  TButtonGlyph(FGlyph).OnChange := GlyphChanged;
  inherited Create(AOwner);
  Height := 22;
  FCanvas := TCanvas.Create;
  FStyle := baWinXP;
  FKind := bCustom;
  FLayout := baGlyphLeft;
  FSpacing := 4;
  FMargin := -1;
  ControlStyle := ControlStyle + [csReflector];
end;

destructor TMyAutoBitBtn.Destroy;
begin
  inherited Destroy;
  TButtonGlyph(FGlyph).Free;
  FCanvas.Free;
end;

procedure TMyAutoBitBtn.CreateHandle;
var
  State: TautoButtonState;
begin
  if Enabled then
    State := baUp
  else
    State := baDisabled;
  inherited CreateHandle;
  TButtonGlyph(FGlyph).CreateButtonGlyph(State);
end;

procedure TMyAutoBitBtn.SetcurText( Value: string );
begin
  if FcurText <> Value then FcurText := Value;
end;

procedure TMyAutoBitBtn.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or BS_OWNERDRAW;
end;

procedure TMyAutoBitBtn.SelfExit;
begin
  if Assigned( FOnSelfExitevent ) then
  begin
    FOnSelfExitevent( Self);
  end
  else
    inherited;
end;

procedure TMyAutoBitBtn.SelfEnter;
begin
  if Assigned( FOnSelfEnterevent ) then
  begin
    FOnSelfEnterevent( Self);
  end
  else
    inherited;
end;

procedure TMyAutoBitBtn.SelfChange;
begin
  if Assigned( FOnSelfChangeevent ) then
  begin
    FOnSelfChangeevent( Self);
  end
  else
    inherited;
end;

procedure TMyAutoBitBtn.SelfDblClick;
begin
  if Assigned( FOnSelfDblClickevent ) then
  begin
    FOnSelfDblClickevent( Self);
  end
  else
    inherited;
end;

procedure TMyAutoBitBtn.SetButtonStyle(ADefault: Boolean);
begin
  if ADefault <> IsFocused then
  begin
    IsFocused := ADefault;
    Refresh;
  end;
end;
    
procedure TMyAutoBitBtn.Click;
var
  Form: TCustomForm;
  Control: TWinControl;
begin
  case FKind of
    bClose:
      begin
        Form := GetParentForm(Self);
        if Form <> nil then SendMessage(Form.handle,WM_CLOSE,0,0)
        else inherited Click;
      end;
    bHelp:
      begin
        Control := Self;
        while (Control <> nil) and (Control.HelpContext = 0) do
          Control := Control.Parent;
        if Control <> nil then Application.HelpContext(Control.HelpContext)
        else inherited Click;
      end;
    else
      inherited Click;
  end;
end;
    
procedure TMyAutoBitBtn.CNMeasureItem(var Message: TWMMeasureItem);
begin
  with Message.MeasureItemStruct^ do
  begin
    itemWidth := Width;
    itemHeight := Height;
  end;
end;

procedure TMyAutoBitBtn.CNDrawItem(var Message: TWMDrawItem);
begin
  DrawItem(Message.DrawItemStruct^);
end;

procedure TMyAutoBitBtn.DrawItem(const DrawItemStruct: TDrawItemStruct);
var
  IsDown, IsDefault: Boolean;
  State: TautoButtonState;
  Rng : HGDIOBJ;
  R: TRect;
Const
  BBColor : array[Boolean] of TColor = (clBtnHighlight,clBtnShadow);
  FFocusColor : array[boolean] of TColor = ($BEBEBE,$0097E5);
  LFocusColor : array[boolean] of TColor = ($BCBCBC,$82D5FD);
  //BackColor : array[boolean] of TColor = ($EAF0F0,$DAE2E2);
  BackColor : array[boolean] of TColor = ($EAF0F0,clBtnFace);
  RoundValue = 6;
begin
  FCanvas.Handle := DrawItemStruct.hDC;
  R := ClientRect;
  with DrawItemStruct do
  begin
    IsDown := itemState and ODS_SELECTED <> 0; IsDefault := itemState and ODS_FOCUS <> 0;
    if not Enabled then State := baDisabled  else if IsDown then State := baDown
    else State := baUp;
  end;
  Case FStyle of
    baWinXP:
    begin
      Rng := CreateRoundRectRgn(0,0,Width+1,Height+1,
        RoundValue-Integer(osvi.dwPlatformId=VER_PLATFORM_WIN32_NT)*2,
        RoundValue-Integer(osvi.dwPlatformId=VER_PLATFORM_WIN32_NT)*2);
      SelectClipRgn(FCanvas.Handle,Rng);
      DeleteObject(Rng);
      FCanvas.Brush.Color := BackColor[IsDown];
      if not Enabled then
      begin
        FCanvas.Pen.Color := GetSysColor(COLOR_3DSHADOW);
        FCanvas.RoundRect(0,0,Width,Height,RoundValue,RoundValue);
      end
      else
      begin
        try
          if IsDown then
          begin
            FCanvas.Brush.Color := BackColor[isDown];
          end
          else
          begin
            DrawColor_TB(FCanvas.Handle,clBtnFace,clWhite,Rect(1,1,Width-1,Height-1));
            FCanvas.Brush.Style := bsClear;
       //**************************************************//
          end;
          FCanvas.Pen.Color := clNavy;
          FCanvas.RoundRect(0,0,Width,Height,RoundValue,RoundValue);
        finally

        end;
      end;
      FCanvas.Font := Self.Font;
      TButtonGlyph(FGlyph).Draw(FCanvas, Rect(R.Left,R.Top-1,R.Right,R.Bottom), Point(0,0), Caption, FLayout, FMargin,FSpacing, State, True, DrawTextBiDiModeFlags(0));
      if not isDown and Enabled and FGetFocus then
      begin
        FCanvas.Brush.Style := bsClear;
        FCanvas.Pen.Color := FFocusColor[FGetFocus];
        InflateRect(R, -1,-1);
        FCanvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,RoundValue-2,RoundValue-2);
        FCanvas.Pen.Color := LFocusColor[FGetFocus];
        InflateRect(R, -1,-1);
        FCanvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,RoundValue-2,RoundValue-2);
      end;
      if IsFocused or IsDefault then
      begin
        FCanvas.Brush.Style := bsClear;
        FCanvas.Pen.Color := RGB(149,180,232);
        InflateRect(R,-1,-1);
        FCanvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,RoundValue-2,RoundValue-2);
      end;
      if IsFocused and IsDefault then
      begin
        R := ClientRect; InflateRect(R, -3,-3);
        FCanvas.Pen.Color := clWindowFrame;FCanvas.Brush.Color := clBtnFace;
        DrawFocusRect(FCanvas.Handle, R);
      end;
    end;
    baOffice:
    begin
      FCanvas.Brush.Color := TWinControl(Parent).Brush.Color;
      FCanvas.Pen.Color := RGB(192,192,192);
      FCanvas.RoundRect(0,0,Width,Height,RoundValue+Integer(FGetFocus)*2,RoundValue+Integer(FGetFocus)*2);
      if FGetFocus then
      begin
        FCanvas.Pen.Color := TWinControl(Parent).Brush.Color;
        FCanvas.RoundRect(0,0,Width,Height,RoundValue,RoundValue);
        FCanvas.Pen.Color := $D0E7E0;
      end else FCanvas.Pen.Color := $C0C0C0;
      FCanvas.Font := Self.Font;
      if IsDown then OffsetRect(R, 1, 1);
      TButtonGlyph(FGlyph).Draw(FCanvas, R, Point(0,0), Caption, FLayout, FMargin,
        FSpacing, State, True, DrawTextBiDiModeFlags(0));
      if FGetFocus then
      begin
        FCanvas.Pen.Color := BBColor[isDown];
        FCanvas.Polyline([Point(1, Height-4),Point(1,2)]);
        FCanvas.Pixels[2,2]:=BBColor[isDown];
        FCanvas.Polyline([Point(3,1),Point(Width-3,1)]);
        FCanvas.Pixels[Width-3,2]:=BBColor[isDown];
        FCanvas.Pen.Color := BBColor[not isDown];
        FCanvas.Polyline([Point(2, Height-3), Point(3, Height-2), Point(Width-4,Height-2),
        Point(Width-2,Height-3)]);
        FCanvas.Polyline([Point(Width-2, 3), Point(Width-2, Height-3)]);
      end;
      if IsFocused and IsDefault then
      begin
        R := ClientRect;
        InflateRect(R, -(Width-FCanvas.TextWidth(Caption)-GetGlyph.Width-4) div 2, -(Height-GetGlyph.Height) div 2);
        FCanvas.Pen.Color := clWindowFrame;
        FCanvas.Brush.Color := clBtnFace;
        DrawFocusRect(FCanvas.Handle, R);
      end;
    end;
  end;
  FCanvas.Handle := 0;
end;

procedure TMyAutoBitBtn.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TMyAutoBitBtn.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;
    
procedure TMyAutoBitBtn.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;
    
function TMyAutoBitBtn.GetPalette: HPALETTE;
begin
  Result := Glyph.Palette;
end;
    
procedure TMyAutoBitBtn.SetGlyph(Value: TBitmap);
begin
  TButtonGlyph(FGlyph).Glyph := Value as TBitmap;
  FModifiedGlyph := True;
  Invalidate;
end;
    
function TMyAutoBitBtn.GetGlyph: TBitmap;
begin
  Result := TButtonGlyph(FGlyph).Glyph;
end;
    
procedure TMyAutoBitBtn.GlyphChanged(Sender: TObject);
begin
  Invalidate;
end;
    
function TMyAutoBitBtn.IsCustom: Boolean;
begin
  Result := Kind = bCustom;
end;
    
procedure TMyAutoBitBtn.SetStyle(Value: TautoButtonStyle);
begin
  if Value <> FStyle then
  begin
    FStyle := Value;
    Invalidate;
  end;
end;
    
procedure TMyAutoBitBtn.SetKind(Value: TMyAutoBitBtnKind);
begin
  if Value <> FKind then
  begin
    if Value <> bCustom then
    begin
      Default := Value in [bOK, bYes];
      Cancel := Value in [bCancel, bNo];
    
      if ((csLoading in ComponentState) and (Caption = '')) or
        (not (csLoading in ComponentState)) then
      begin
        if BitBtnCaptions950[Value] <> '' then
        begin
          Caption := BitBtnCaptions950[Value];//LoadResString(BitBtnCaptions950[Value]);
          CurText := BitBtnCaptions950[Value];
        end;
      end;
    
      ModalResult := BitBtnModalResults[Value];
      TButtonGlyph(FGlyph).Glyph := GetBitBtnGlyph(Value);
      NumGlyphs := 1;
      FModifiedGlyph := False;
    end;
    FKind := Value;
    Invalidate;
  end;
end;
    
function TMyAutoBitBtn.IsCustomCaption: Boolean;
begin
  //Result := AnsiCompareStr(Caption, LoadResString(BitBtnCaptions950[FKind])) <> 0;
  Result := AnsiCompareStr(Caption, BitBtnCaptions950[FKind]) <> 0;
end;
    
function TMyAutoBitBtn.GetKind: TMyAutoBitBtnKind;
begin
  if FKind <> bCustom then
    if ((FKind in [bOK, bYes]) xor Default) or
      ((FKind in [bCancel, bNo]) xor Cancel) or
      (ModalResult <> BitBtnModalResults[FKind]) or
      FModifiedGlyph then
      FKind := bCustom;
  Result := FKind;
end;
    
procedure TMyAutoBitBtn.SetLayout(Value: TautoButtonLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;
    
function TMyAutoBitBtn.GetNumGlyphs: TautoNumGlyphs;
begin
  Result := TButtonGlyph(FGlyph).NumGlyphs;
end;
    
procedure TMyAutoBitBtn.SetNumGlyphs(Value: TautoNumGlyphs);
begin
  if Value < 0 then Value := 1
  else if Value > 4 then Value := 4;
  if Value <> TButtonGlyph(FGlyph).NumGlyphs then
  begin
    TButtonGlyph(FGlyph).NumGlyphs := Value;
    Invalidate;
  end;
end;
    
procedure TMyAutoBitBtn.SetSpacing(Value: Integer);
begin
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;
    
procedure TMyAutoBitBtn.SetMargin(Value: Integer);
begin
  if (Value <> FMargin) and (Value >= - 1) then
  begin
    FMargin := Value;
    Invalidate;
  end;
end;

procedure TMyAutoBitBtn.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;//! for lack of a better color
      Canvas.FillRect(Rect(0,0, Width, Height));
      ImageList.Draw(Canvas, 0, 0, Index);
    end;
  end;

begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      { 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(ActionList.Images, ImageIndex);
    end;
end;

procedure DestroyLocals; far;
var
  I: TMyAutoBitBtnKind;
begin
  for I := Low(TMyAutoBitBtnKind) to High(TMyAutoBitBtnKind) do
    BitBtnGlyphs[I].Free;
end;

procedure TMyAutoBitBtn.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if not FGetFocus then
  begin
    FGetFocus:=True;
    Invalidate;
  end;
end;

procedure TMyAutoBitBtn.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if FGetFocus then
  begin
    FGetFocus:=False;
    Invalidate;
  end;
end;

initialization
  FillChar(BitBtnGlyphs, SizeOf(BitBtnGlyphs), 0);
  osvi.dwOSVersionInfoSize := Sizeof(TOSVersionInfo);
  GetVersionEx(osvi);

finalization
  DestroyLocals;
end.