suibutton.pas

新颖按钮控件

    inherited;

    if IsAccel(Msg.CharCode, m_Caption) and Enabled then
    begin
        SetFocus();
        m_MouseUp := true;
        Click();
        m_MouseUp := false;
        Msg.Result := 1;
    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();

            m_MouseUp := true;
            Click();
            m_MouseUp := false;
        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.FSetCaption(const Value: TCaption);
begin
    m_Caption := Value;

    CaptionChanged();
    Repaint();
end;

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

    EnableChanged();
    Repaint();
end;

procedure TsuiCustomButton.Click;
begin
    if not m_MouseUp then
        Exit;

    if not Enabled then
        Exit;

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

    if (
        Assigned(m_OnClick) and
        (Action <> nil) and
        (@m_OnClick <> @Action.OnExecute)
    ) then
        m_OnClick(Self)
    else if (
        (not (csDesigning in ComponentState)) and
        (ActionLink <> nil)
    ) then
        ActionLink.Execute()
    else if Assigned(m_OnClick) then
        m_OnClick(Self);
end;

procedure TsuiCustomButton.SetTabStop(const Value: Boolean);
begin
    m_TabStop := Value;

    inherited TabStop := m_TabStop;
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;

function TsuiCustomButton.GetResHandle: THandle;
begin
    if m_hDLL = hInstance then
        Result := 0
    else
        Result := m_hDLL;
end;

procedure TsuiCustomButton.SetResHandle(const Value: THandle);
begin
    if Value = 0 then
        m_hDLL := hInstance
    else
        m_hDLL := Value;
end;

function TsuiCustomButton.GetPicMouseDown: String;
begin
    Result := m_PicMouseDown;
end;

function TsuiCustomButton.GetPicMouseOn: String;
begin
    Result := m_PicMouseOn;
end;

function TsuiCustomButton.GetPicNormal: String;
begin
    Result := m_PicNormal;
end;

procedure TsuiCustomButton.CMFocusChanged(var Msg: TCMFocusChanged);
begin
    Inherited;

    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;
    SetButtonPic(m_UIStyle);
    UIStyleChanged();
    Repaint();
end;

procedure TsuiCustomButton.PaintText(ACanvas: TCanvas; Text: String);
var
    R : TRect;
begin
    ACanvas.Brush.Style := bsClear;
    R := ClientRect;
    ACanvas.Font := Font;
    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);
        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);
end;

procedure TsuiCustomButton.UIStyleChanged;
begin
    if m_UIStyle = Custom then
        AutoSize := true;
end;

procedure TsuiCustomButton.AutoSizeChanged;
var
    Temp : TBitmap;
begin
    if m_AutoSize and (m_PicNormal <> '') then
    begin
        Temp := TBitmap.Create();
        try
            Temp.LoadFromResourceName(m_hDLL, m_PicNormal);
        except
            Temp.Height := 21;
            Temp.Width := 74;
        end;
        Height := Temp.Height;
        Width := Temp.Width;
        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(2, 2, ClientWidth - 2, ClientHeight - 2);
    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
    Buf.LoadFromResourceName(m_hDLL, m_PicNormal)
end;

procedure TsuiCustomButton.PaintButtonMouseDown(Buf: TBitmap);
begin
    Buf.LoadFromResourceName(m_hDLL, m_PicMouseDown)
end;

procedure TsuiCustomButton.PaintButtonMouseOn(Buf: TBitmap);
begin
    Buf.LoadFromResourceName(m_hDLL, m_PicMouseOn)
end;

procedure TsuiCustomButton.PaintButtonNormal(Buf: TBitmap);
begin
    Buf.LoadFromResourceName(m_hDLL, m_PicNormal);
end;

{ TsuiButton }

function TsuiButton.CanResize(var NewWidth, NewHeight: Integer): Boolean;
begin
    Result := false;

    if (NewHeight <> 23) and (m_UIStyle = MacOS) then
        Exit;

    Result := true;
end;

constructor TsuiButton.Create(AOwner: TComponent);
begin
    inherited;

    Height := 27;
    Width := 80;
    m_Spacing := 4;
    m_Glyph := TBitmap.Create();
    UIStyle := GetSUIFormStyle(TCustomForm(AOwner));
end;

destructor TsuiButton.Destroy;
begin
    m_Glyph.Free();
    m_Glyph := nil;

    inherited;
end;

function TsuiButton.GetPicMouseDown: String;
begin
    if m_UIStyle <> Custom then
        Result := ''
    else
        Result := inherited GetPicMouseDown();
end;

function TsuiButton.GetPicMouseOn: String;
begin
    if m_UIStyle <> Custom then
        Result := ''
    else
        Result := inherited GetPicMouseOn();
end;

function TsuiButton.GetPicNormal: String;
begin
    if m_UIStyle <> Custom then
        Result := ''
    else
        Result := inherited GetPicNormal();
end;

procedure TsuiButton.PaintFocus(ACanvas: TCanvas);
begin
    if (UIStyle = MacOS) or (UIStyle = BlueGlass) then
    begin
        ACanvas.Pen.Color := clBlue;
        ACanvas.Pen.Width := 1;
        ACanvas.MoveTo(10, Height - 5);
        ACanvas.LineTo(Width - 10, Height - 5);
       
        Exit;
    end;

    inherited
end;

procedure TsuiButton.PaintPic(ACanvas: TCanvas; Bitmap: TBitmap);
var
    CapWidth : Integer;
    CapHeight : Integer;
    GlyphLeft : Integer;
    GlyphTop : Integer;
    GlyphWidth : Integer;
    GlyphHeight : Integer;
    ImageList : TImageList;
    IncludedDisable : Boolean;
begin
    ACanvas.Font := Font;
    if m_UIStyle = Custom then
        inherited
    else
        SpitDraw(Bitmap, ACanvas, ClientRect, PicTransparent);

    if m_Glyph.Empty then
        Exit;

    CapWidth := ACanvas.TextWidth(Caption);
    CapHeight := ACanvas.TextHeight(Caption);

    GlyphLeft := 0;
    GlyphTop := 0;
    GlyphWidth := m_Glyph.Width;
    GlyphHeight := m_Glyph.Height;
    IncludedDisable := false;

    if GlyphWidth = GlyphHeight * 2 then
    begin
        GlyphWidth := GlyphHeight;
        IncludedDisable := true;
    end;

    case m_Layout of

    blGlyphLeft :
    begin
        GlyphLeft := (Width - (CapWidth + GlyphWidth + m_Spacing)) div 2;
        GlyphTop := (Height - GlyphHeight) div 2;
        m_TextPoint := Point(GlyphLeft + GlyphWidth + m_Spacing, (Height - CapHeight) div 2);
    end;

    blGlyphRight :
    begin
        GlyphLeft := (Width + CapWidth + m_Spacing - GlyphWidth) div 2;
                  // (Width - (CapWidth + GlyphWidth + GLYPH_TEXT)) div 2 + CapWidth + GLYPH_TEXT;
        GlyphTop := (Height - GlyphHeight) div 2;
        m_TextPoint := Point(GlyphLeft - CapWidth - m_Spacing, (Height - CapHeight) div 2);
    end;

    blGlyphTop :
    begin
        GlyphLeft := (Width - GlyphWidth) div 2;
        GlyphTop := (Height - (CapHeight + GlyphHeight + m_Spacing)) div 2;
        m_TextPoint := Point((Width - CapWidth) div 2, GlyphTop + GlyphHeight + m_Spacing);
    end;

    blGlyphBottom :
    begin
        GlyphLeft := (Width - GlyphWidth) div 2;
        GlyphTop := (Height + CapHeight + m_Spacing - GlyphHeight) div 2;
        m_TextPoint := Point((Width - CapWidth) div 2, GlyphTop - CapHeight - m_Spacing);
    end;

    end; // case

    if m_MouseDown then
    begin
        Inc(GlyphLeft);
        Inc(GlyphTop);
    end;

    ImageList := TImageList.CreateSize(GlyphWidth, GlyphHeight);

    try
        ImageList.AddMasked(m_Glyph, m_Glyph.Canvas.Pixels[0, 0]);

        if not IncludedDisable then
            ImageList.Draw(ACanvas, GlyphLeft, GlyphTop, 0, Enabled)
        else
            ImageList.Draw(ACanvas, GlyphLeft, GlyphTop, Integer(not Enabled));
    finally
        ImageList.Free();
    end;
end;

procedure TsuiButton.PaintText(ACanvas: TCanvas; Text: String);
var
    R : TRect;
begin
    if m_Glyph.Empty then
    begin
        inherited;
        Exit;
    end;

    ACanvas.Brush.Style := bsClear;
    ACanvas.Font := Font;

    if not Enabled then
    begin
        ACanvas.Font.Color := clWhite;
        R := Rect(m_TextPoint.X + 1,  m_TextPoint.Y + 1, Width, Height);
        DrawText(ACanvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_TOP or DT_SINGLELINE);
        ACanvas.Font.Color := clGray;
    end
    else
    begin
        if m_MouseDown then
        begin
            Inc(m_TextPoint.X);
            Inc(m_TextPoint.Y);
        end;
    end;

    R := Rect(m_TextPoint.X, m_TextPoint.Y, Width, Height);
    DrawText(ACanvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_TOP or DT_SINGLELINE);
end;

procedure TsuiButton.SetButtonPic(var UIStyle : TsuiUIStyle);
begin
    if UIStyle = Custom then
        Exit;

    m_hDLL := hInstance;