suibutton.pas

SUIPack是一款为Delphi和C++Builder开发的所见即所得的界面增强VCL组件

    inherited Caption := '';

    m_MouseIn := false;
    m_MouseDown := false;

    ModalResult := mrNone;
    TabStop := true;
    m_AutoSize := false;
    m_FocusedRectMargin := 2;

    UIStyle := GetSUIFormStyle(AOwner);
end;

procedure TsuiCustomButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
    if Button = mbLeft then
    begin
        m_MouseDown := true;
        if m_Timer = nil then
        begin
            m_Timer := TTimer.Create(nil);
            m_Timer.OnTimer := OnTimer;
            m_Timer.Interval := Max(m_MouseContinuouslyDownInterval, 0);
            m_Timer.Enabled := true;
        end;

        if TabStop and CanFocus() and Enabled and Visible then
        try
            SetFocus();
        except end;

        Repaint();
    end;

    inherited;
end;

procedure TsuiCustomButton.MouseEnter(var Msg: TMessage);
begin
    inherited;

    if csDesigning in ComponentState then
        Exit;

    m_MouseIn := true;
    Repaint();

    if Assigned(m_OnMouseEnter) then
        m_OnMouseEnter(self);
end;

procedure TsuiCustomButton.MouseLeave(var Msg: TMessage);
begin
    inherited;

    m_MouseIn := false;
    m_MouseDown := false;
    if m_Timer <> nil then
    begin
        m_Timer.Free();
        m_Timer := nil;
    end;

    Repaint();

    if Assigned(m_OnMouseExit) then
        m_OnMouseExit(self);
end;

procedure TsuiCustomButton.Paint;
var
    Buf : TBitmap;
    BufImage : TBitmap;
begin
    Buf := TBitmap.Create();
    BufImage := TBitmap.Create();

    try
        if not Enabled then
            PaintButtonDisabled(BufImage)
        else if m_MouseDown then
            PaintButtonMouseDown(BufImage)
        else if not m_MouseIn then
            PaintButtonNormal(BufImage)
        else
            PaintButtonMouseOn(BufImage);
    except
        BufImage.Width := 74;
        BufImage.Height := 21;
    end;
    BufImage.Transparent := m_PicTransparent;

    Buf.PixelFormat := pfDevice;
    Buf.Width := Width;
    Buf.Height := Height;

    if m_Transparent then
    begin
        if Parent <> nil then
        begin
            if Parent is TTabSheet then
                DoTrans(Buf.Canvas, Parent)
{$IFDEF DB}
            else if Parent is TsuiDBNavigator then
                DoTrans(Buf.Canvas, Parent)
{$ENDIF}                
            else if (Parent is TsuiToolBar) then
                DoTrans(Buf.Canvas, Parent)
            else
                DoTrans(Buf.Canvas, self);
        end
        else
            DoTrans(Buf.Canvas, self);
    end
    else
    begin
        Buf.Canvas.Brush.Color := Color;
        Buf.Canvas.FillRect(ClientRect);
    end;

    PaintPic(Buf.Canvas, BufImage);

    BufImage.Free();

    if Focused and TabStop then
        PaintFocus(Buf.Canvas);

    Buf.Canvas.Font := Font;
    Canvas.Font := Font;
    if Trim(m_Caption) <> '' then
        PaintText(Buf.Canvas, m_Caption);

    Canvas.CopyRect(ClientRect, Buf.Canvas, ClientRect);

    Buf.Free();
end;

procedure TsuiCustomButton.SetAutoSize2(const Value: Boolean);
begin
    m_AutoSize := Value;
    AutoSizeChanged();
    RePaint();
end;

procedure TsuiCustomButton.CMDialogChar(var Msg: TCMDialogChar);
begin
    inherited;

    if IsAccel(Msg.CharCode, m_Caption) then
    begin
        if ((Parent <> nil) and (Parent.Enabled)) and Enabled and Visible then
        begin
            Click();
            Msg.Result := 1;
        end
        else
            Msg.Result := 0;
    end
    else
        Msg.Result := 0;
end;

procedure TsuiCustomButton.WMKeyDown(var Msg: TWMKeyDown);
begin
    inherited;

    if (
        ((Msg.CharCode = VK_SPACE) or (Msg.CharCode = VK_RETURN)) and
        Focused
    ) then
    begin
        if Enabled then
        begin
            m_MouseDown := true;
            Repaint();
        end;
    end;
end;

procedure TsuiCustomButton.WMKeyUp(var Msg: TWMKeyUp);
begin
    inherited;

    if (
        ((Msg.CharCode = VK_SPACE) or (Msg.CharCode = VK_RETURN)) and
        Focused and
        (m_MouseDown)
    ) then
    begin
        if Enabled then
        begin
            m_MouseDown := false;
            Repaint();
            Click();
        end;
    end;
end;

procedure TsuiCustomButton.WMKillFocus(var Msg: TWMKillFocus);
begin
    inherited;

    Repaint();
end;

procedure TsuiCustomButton.WMSetFocus(var Msg: TWMSetFocus);
begin
    inherited;

    Repaint();
end;

procedure TsuiCustomButton.SetCaption2(const Value: TCaption);
begin
    m_Caption := Value;
    inherited Caption := Value;

    CaptionChanged();
    Repaint();
end;

procedure TsuiCustomButton.SetEnabled(Value: Boolean);
begin
    inherited;

    EnableChanged();
    Repaint();
end;

procedure TsuiCustomButton.Click;
begin
    if m_MouseDown then
    begin
        if m_Timer <> nil then
        begin
            m_Timer.Free();
            m_Timer := nil;
        end;

        m_MouseDown := false;
        Repaint();
    end;

    if Parent <> nil then
        GetParentForm(self).ModalResult := m_ModalResult;
    inherited;
end;

procedure TsuiCustomButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
    inherited;

    if (
        (X < 0) or
        (Y < 0) or
        (X > Width) or
        (Y > Height)
    ) then
    begin
        m_MouseIn := false;
        m_MouseDown := false;
        Repaint();
    end;
end;

procedure TsuiCustomButton.SetTransparent(const Value: Boolean);
begin
    inherited;

    m_Transparent := Value;
    TransparentChanged();
    Repaint();
end;

procedure TsuiCustomButton.WMERASEBKGND(var Msg: TMessage);
begin
    // do nothing
end;

procedure TsuiCustomButton.CMFocusChanged(var Msg: TCMFocusChanged);
begin
    Inherited;
    with Msg do
    if Sender is TsuiButton then
      m_Active := Sender = Self
    else
      m_Active := m_Default;
    Repaint();
end;

procedure TsuiCustomButton.PaintPic(ACanvas: TCanvas; Bitmap: TBitmap);
var
    ImageList : TImageList;
    TransColor : TColor;
begin
    if (Bitmap.Width = 0) or (Bitmap.Height = 0) then
        Exit;

    TransColor := Bitmap.Canvas.Pixels[0, 0];

    ImageList := TImageList.CreateSize(Bitmap.Width, Bitmap.Height);
    try
        if PicTransparent then
            ImageList.AddMasked(Bitmap, TransColor)
        else
            ImageList.Add(Bitmap, nil);
        ImageList.Draw(ACanvas, 0, 0, 0, Enabled);
    finally
        ImageList.Free();
    end;
end;

procedure TsuiCustomButton.SetUIStyle(const Value: TsuiUIStyle);
begin
    m_UIStyle := Value;
    UIStyleChanged();
    Repaint();
end;

procedure TsuiCustomButton.PaintText(ACanvas: TCanvas; Text: String);
var
    R, RText : TRect;
    DespX, DespY : integer;
begin
    ACanvas.Brush.Style := bsClear;
    R := ClientRect;
    ACanvas.Font := Font;
    if m_BoldFont then
        ACanvas.Font.Style := ACanvas.Font.Style + [fsBold];

    if not Enabled then
    begin
        R := Rect(R.Left + 1, R.Top + 1, R.Right + 1, R.Bottom + 1);
        ACanvas.Font.Color := clWhite;
//        DrawText(ACanvas.Handle, PChar(Caption), -1, R, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
        RText := R;
        DrawText(ACanvas.Handle, PChar(Caption),Length(Caption), RText, DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK);
        DespX := ((R.Right - R.Left) - (RText.Right - RText.Left)) div 2;
        DespY := ((R.Bottom - R.Top) - (RText.Bottom - RText.Top)) div 2;
        OffsetRect(RText,DespX, DespY);
        DrawText(ACanvas.Handle, PChar(Caption),-1, RText, DT_CENTER);
        
        R := ClientRect;
        ACanvas.Font.Color := clGray;
    end
    else
    begin
        if m_MouseDown then
            R := Rect(R.Left + 1, R.Top + 1, R.Right + 1, R.Bottom + 1);
    end;
//    DrawText(ACanvas.Handle, PChar(Caption), -1, R, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
    RText := R;
    DrawText(ACanvas.Handle, PChar(Caption),Length(Caption), RText, DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK);
    DespX := ((R.Right - R.Left) - (RText.Right - RText.Left)) div 2;
    DespY := ((R.Bottom - R.Top) - (RText.Bottom - RText.Top)) div 2;
    OffsetRect(RText,DespX, DespY);
    DrawText(ACanvas.Handle, PChar(Caption),-1, RText, DT_CENTER);

    m_BoldFont := false;
end;

procedure TsuiCustomButton.UIStyleChanged;
begin

end;

procedure TsuiCustomButton.AutoSizeChanged;
var
    Temp : TBitmap;
begin
    if m_AutoSize then
    begin
        Temp := TBitmap.Create();
        GetInsideThemeBitmap(m_UIStyle, SUI_THEME_BUTTON_IMAGE, Temp);
        if Temp.Height = 0 then
            Temp.Height := 21;
        if Temp.Width = 0 then
            Temp.Width := 74;
        Height := Temp.Height;
        Width := Temp.Width div 3;
        Temp.Free();
    end;
end;

procedure TsuiCustomButton.CaptionChanged;
begin
    // do nothing
end;

procedure TsuiCustomButton.CMFONTCHANGED(var Msg: TMessage);
begin
    FontChanged();
end;

procedure TsuiCustomButton.FontChanged;
begin
    Canvas.Font := Font;
    Repaint();
end;

procedure TsuiCustomButton.SetPicTransparent(const Value: Boolean);
begin
    m_PicTransparent := Value;
    Repaint();
end;

procedure TsuiCustomButton.TransparentChanged;
begin
    PicTransparent := Transparent;
end;

procedure TsuiCustomButton.PaintFocus(ACanvas: TCanvas);
var
    R : TRect;
begin
    R := Rect(m_FocusedRectMargin, m_FocusedRectMargin, ClientWidth - m_FocusedRectMargin, ClientHeight - m_FocusedRectMargin);
    ACanvas.Brush.Style := bsSolid;
    ACanvas.DrawFocusRect(R);
end;

procedure TsuiCustomButton.EnableChanged;
begin
    // Do nothing
end;

procedure TsuiCustomButton.ActionChange(Sender: TObject;
  CheckDefaults: Boolean);
begin
    inherited;

    Caption := inherited Caption;
end;

procedure TsuiCustomButton.PaintButtonDisabled(Buf: TBitmap);
begin
    PaintButton(SUI_THEME_BUTTON_IMAGE, 3, 1, Buf);
end;

procedure TsuiCustomButton.PaintButtonMouseDown(Buf: TBitmap);
begin
    PaintButton(SUI_THEME_BUTTON_IMAGE, 3, 3, Buf);
end;

procedure TsuiCustomButton.PaintButtonMouseOn(Buf: TBitmap);
begin
    PaintButton(SUI_THEME_BUTTON_IMAGE, 3, 2, Buf);
end;

procedure TsuiCustomButton.PaintButtonNormal(Buf: TBitmap);
begin
    PaintButton(SUI_THEME_BUTTON_IMAGE, 3, 1, Buf);
end;

procedure TsuiCustomButton.OnTimer(Sender: TObject);
begin
    if Assigned(m_OnMouseContinuouslyDown) then
        m_OnMouseContinuouslyDown(self);
end;

procedure TsuiCustomButton.SetDefault(const Value: Boolean);
var
    Form: TCustomForm;
begin
    m_Default := Value;
    if HandleAllocated then
    begin
        Form := GetParentForm(Self);
        if Form <> nil then
            Form.Perform(CM_FOCUSCHANGED, 0, Longint(Form.ActiveControl));
  end;
end;

procedure TsuiCustomButton.CMDialogKey(var Message: TCMDialogKey);
begin
    with Message do
    if  (((CharCode = VK_RETURN) and m_Active) or
      ((CharCode = VK_ESCAPE) and m_Cancel)) and
      (KeyDataToShiftState(Message.KeyData) = []) and CanFocus then
    begin
      Click;
      Result := 1;
    end else
      inherited;
end;

function TsuiCustomButton.GetTabStop: Boolean;
begin
    Result := inherited TabStop;
end;

procedure TsuiCustomButton.SetTabStop(Value: Boolean);
begin
    inherited TabStop := Value;
end;

procedure TsuiCustomButton.SetFileTheme(const Value: TsuiFileTheme);
begin
    m_FileTheme := Value;
    SetUIStyle(m_UIStyle);
end;

procedure TsuiCustomButton.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
    inherited;

    if (
        (Operation = opRemove) and
        (AComponent = m_FileTheme)
    )then
    begin