flatbtns.pas

风格控件。。支持数据库和界面风格优化

  end;

  // DrawBorder
  case FState of
    bsUp:            
      if FMouseIn then
         DrawButtonBorder(canvas, ClientRect, FColorShadow, 1)
      else
         DrawButtonBorder(canvas, ClientRect, FColorBorder, 1);
    bsDown, bsExclusive:
         DrawButtonBorder(canvas, ClientRect, FColorShadow, 1);
    bsDisabled:
         DrawButtonBorder(canvas, ClientRect, FColorBorder, 1);
  end;

  // DrawGlyph
  if not FGlyph.Empty then
  begin
    tempGlyph := TBitmap.Create;
    case FNumGlyphs of
      1: case FState of
           bsUp:        sourceRect := Rect(0, 0, FGlyph.Width, FGlyph.Height);
           bsDisabled:  sourceRect := Rect(0, 0, FGlyph.Width, FGlyph.Height);
           bsDown:      sourceRect := Rect(0, 0, FGlyph.Width, FGlyph.Height);
           bsExclusive: sourceRect := Rect(0, 0, FGlyph.Width, FGlyph.Height);
         end;
      2: case FState of
           bsUp:        sourceRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
           bsDisabled:  sourceRect := Rect(FGlyph.Width div FNumGlyphs, 0, FGlyph.Width, FGlyph.Height);
           bsDown:      sourceRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
           bsExclusive: sourceRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
         end;
      3: case FState of
           bsUp:        SourceRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
           bsDisabled:  SourceRect := Rect(FGlyph.width div FNumGlyphs, 0, (FGlyph.Width div FNumGlyphs) * 2, FGlyph.Height);
           bsDown:      SourceRect := Rect((FGlyph.Width div FNumGlyphs) * 2, 0, FGlyph.Width, FGlyph.Height);
           bsExclusive: SourceRect := Rect((FGlyph.Width div FNumGlyphs) * 2, 0, FGlyph.Width, FGlyph.Height);
         end;
      4: case FState of
           bsUp:        SourceRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
           bsDisabled:  SourceRect := Rect(FGlyph.width div FNumGlyphs, 0, (FGlyph.Width div FNumGlyphs) * 2, FGlyph.Height);
           bsDown:      SourceRect := Rect((FGlyph.Width div FNumGlyphs) * 2, 0, (FGlyph.Width div FNumGlyphs) * 3, FGlyph.Height);
           bsExclusive: SourceRect := Rect((FGlyph.width div FNumGlyphs) * 3, 0, FGlyph.Width, FGlyph.Height);
         end;
    end;

    destRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
    tempGlyph.Width := FGlyph.Width div FNumGlyphs;
    tempGlyph.Height := FGlyph.Height;
    tempGlyph.canvas.copyRect(destRect, FGlyph.canvas, sourcerect);

    if (FNumGlyphs = 1) and (FState = bsDisabled) then
    begin
      tempGlyph := CreateDisabledBitmap(tempGlyph, clBlack, clBtnFace, clBtnHighlight, clBtnShadow, True);
      FTransColor := tempGlyph.Canvas.Pixels[0, tempGlyph.Height - 1];
    end;

    FImageList := TImageList.CreateSize(FGlyph.Width div FNumGlyphs, FGlyph.Height);
    try
      FImageList.AddMasked(tempGlyph, FTransColor);
      FImageList.Draw(canvas, glyphpos.x, glyphpos.y, 0);
    finally
      FImageList.Free;
    end;
    tempGlyph.free;
  end;

  // DrawText
  Canvas.Brush.Style := bsClear;
  if FState = bsDisabled then
  begin
    OffsetRect(TextBounds, 1, 1);
    Canvas.Font.Color := clBtnHighlight;
    DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    OffsetRect(TextBounds, -1, -1);
    Canvas.Font.Color := clBtnShadow;
    DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  end
  else
    DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end;

procedure TDefineSpeed.UpdateTracking;
var
  P: TPoint;
begin
  if Enabled then
  begin
    GetCursorPos(P);
    FMouseIn := not (FindDragTarget(P, True) = Self);
    if FMouseIn then
      MouseLeave
    else
      MouseEnter;
  end;
end;

procedure TDefineSpeed.Loaded;
begin
  inherited Loaded;
  Invalidate;
end;

procedure TDefineSpeed.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if(Button = mbLeft) and Enabled then
  begin
    if not FDown then
    begin
      FState := bsDown;
      Invalidate;
    end;
    FDragging := True;
  end;
end;

procedure TDefineSpeed.MouseMove (Shift: TShiftState; X, Y: Integer);
var
  NewState: TButtonState;
begin
  inherited;
  if FDragging then
  begin
    if not FDown then
      NewState := bsUp
    else
      NewState := bsExclusive;
    if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
      if FDown then
        NewState := bsExclusive
      else
        NewState := bsDown;
    if NewState <> FState then
    begin
      FState := NewState;
      Invalidate;
    end;
  end;
end;

procedure TDefineSpeed.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  DoClick: Boolean;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FDragging then
  begin
    FDragging := False;
    DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
    if FGroupIndex = 0 then
    begin
      // Redraw face in-case mouse is captured
      FState := bsUp;
      FMouseIn := False;
      if DoClick and not (FState in [bsExclusive, bsDown]) then
        Invalidate;
    end
    else
      if DoClick then
      begin
        SetDown(not FDown);
        if FDown then Repaint;
      end
      else
      begin
        if FDown then FState := bsExclusive;
        Repaint;
      end;
    if DoClick then Click else MouseLeave;
    UpdateTracking;
  end;
end;

procedure TDefineSpeed.Click;
begin
  if Parent <> nil then
     GetParentForm(self).ModalResult := FModalResult;
  if Assigned(PopupMenu) then
     PopupMenu.PopUp(ClientToScreen(Point(0, Height)).X,
                     ClientToScreen(Point(0, Height)).Y);
  inherited Click;
end;

function TDefineSpeed.GetPalette: HPALETTE;
begin
  Result := FGlyph.Palette;
end;

procedure TDefineSpeed.SetColors(Index: Integer; Value: TColor);
begin
  case Index of
    0: fColorFocused := Value;
    1: fColorDown    := Value;
    2: FColorBorder  := Value;
    3: FColorShadow  := Value;
    4: FColorFlat    := Value;
  end;
  Invalidate;
end;

procedure TDefineSpeed.SetGlyph(Value: TBitmap);
begin
  if value <> FGlyph then
  begin
    FGlyph.Assign(value);
    if not FGlyph.Empty then
    begin
      if FGlyph.Width mod FGlyph.Height = 0 then
      begin
        FNumGlyphs := FGlyph.Width div FGlyph.Height;
        if FNumGlyphs > 4 then FNumGlyphs := 1;
      end;
    end;
    Invalidate;
  end;
end;

procedure TDefineSpeed.SetNumGlyphs(Value: TNumGlyphs);
begin
  if value <> FNumGlyphs then
  begin
    FNumGlyphs := value;
    Invalidate;
  end;
end;

procedure TDefineSpeed.UpdateExclusive;
var
  Msg: TMessage;
begin
  if (FGroupIndex <> 0) and (Parent <> nil) then
  begin
    Msg.Msg := CM_BUTTONPRESSED;
    Msg.WParam := FGroupIndex;
    Msg.LParam := Longint(Self);
    Msg.Result := 0;
    Parent.Broadcast(Msg);
  end;
end;

procedure TDefineSpeed.SetDown(Value: Boolean);
begin
  if FGroupIndex = 0 then Value := False;
  if Value <> FDown then
  begin
    if FDown and (not FAllowAllUp) then Exit;
    FDown := Value;
    if Value then
    begin
      if FState = bsUp then Invalidate;
      FState := bsExclusive
    end
    else
    begin
      FState := bsUp;
      Repaint;
    end;
    if Value then UpdateExclusive;
  end;
end;

procedure TDefineSpeed.SetGroupIndex(Value: Integer);
begin
  if FGroupIndex <> Value then
  begin
    FGroupIndex := Value;
    UpdateExclusive;
  end;
end;

procedure TDefineSpeed.SetLayout(Value: TButtonLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;

procedure TDefineSpeed.SetMargin(Value: Integer);
begin
  if(Value <> FMargin) and(Value >= -1) then
  begin
    FMargin := Value;
    Invalidate;
  end;
end;

procedure TDefineSpeed.SetSpacing(Value: Integer);
begin
  if Value <> FSpacing then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;

procedure TDefineSpeed.SetAllowAllUp(Value: Boolean);
begin
  if FAllowAllUp <> Value then
  begin
    FAllowAllUp := Value;
    UpdateExclusive;
  end;
end;

procedure TDefineSpeed.WMLButtonDblClk(var Message: TWMLButtonDown);
begin
  inherited;
  if FDown then DblClick;
end;

procedure TDefineSpeed.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  if not Enabled then
  begin
    FMouseIn := False;
    FState := bsDisabled;
    //RemoveMouseTimer;
  end;
  UpdateTracking;
  Invalidate;
end;

procedure TDefineSpeed.CMButtonPressed(var Message: TMessage);
var
  Sender: TDefineSpeed;
begin
  if Message.WParam = FGroupIndex then
  begin
    Sender := TDefineSpeed(Message.LParam);
    if Sender <> Self then
    begin
      if Sender.Down and FDown then
      begin
        FDown := False;
        FState := bsUp;
        Invalidate;
      end;
      FAllowAllUp := Sender.AllowAllUp;
    end;
  end;
end;

procedure TDefineSpeed.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and Enabled then
    begin
      Click;
      Result := 1;
    end else
      inherited;
end;

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

procedure TDefineSpeed.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;

procedure TDefineSpeed.CMSysColorChange(var Message: TMessage);
begin
  inherited;
  if (Parent <> nil)and(ParentColor) then
      Color := TDefineSpeed(Parent).Color;
  Invalidate;
end;

procedure TDefineSpeed.CMParentColorChanged(var Message: TWMNoParams);
begin
  inherited;
  if (Parent <> nil)and(not ParentColor) then
      Color := TDefineSpeed(Parent).Color;
  Invalidate;
end;

procedure TDefineSpeed.MouseEnter;
begin
  if Enabled and not FMouseIn  then
  begin
    FMouseIn := True;
    Invalidate;
  end;
end;

procedure TDefineSpeed.MouseLeave;
begin
  if Enabled and FMouseIn and not FDragging then
  begin
    FMouseIn := False;
    Invalidate;
  end;
end;

{$IFDEF DFS_DELPHI_4_UP}
procedure TDefineSpeed.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;
{$ENDIF}

procedure TDefineSpeed.SetTransparent(const Value: TTransparentMode);
begin
  FTransparent := Value;
  Invalidate;
end;

procedure TDefineSpeed.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseEnter) then
     FOnMouseEnter(Self)
  else if not(csDesigning in ComponentState) then
     MouseEnter;
end;

procedure TDefineSpeed.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseLeave) then
     FOnMouseLeave(Self)
  else if not(csDesigning in ComponentState) then
     MouseLeave;
end;

{ TDefineButton }

constructor TDefineButton.Create(AOwner: TComponent);
begin