flatbtns.pas

comerose_flatstyle_v4.42.9.0_d7.rar

  FGlyph        := TBitmap.Create;
  inherited Create(AOwner);
  ControlStyle  := [csCaptureMouse, csOpaque, csDoubleClicks];
  TabStop       := true;
  ParentFont    := True;
  ParentColor   := True;
  fColorFocused := DefaultFocusedColor;
  fColorDown    := DefaultDownColor;
  FColorBorder  := DefaultBorderColor;
  FColorShadow  := DefaultShadowColor;
  FState        := bsUp;
  fColorFlat    := DefaultFlatColor;
  FSpacing      := 4;
  FMargin       := -1;
  FNumGlyphs    := 1;
  FLayout       := blGlyphTop;
  FModalResult  := mrNone;
  FTransparent  := tmNone;
  fHasFocusFrame:= true;

  SetBounds(0, 0, 80, 25);
end;

destructor TDefineButton.Destroy;
begin
  FGlyph.Free;
  inherited Destroy;
end;

procedure TDefineButton.Paint;
var
  FTransColor: TColor;
  FImageList: TImageList;
  sourceRect, destRect, FocusRect: TRect;
  tempGlyph, memBitmap: TBitmap;
  Offset: TPoint;
begin
  // get the transparent color
  FTransColor  := FGlyph.Canvas.Pixels[0, FGlyph.Height - 1];

  memBitmap := TBitmap.Create; // create memory-bitmap to draw flicker-free
  try
    memBitmap.Height := ClientRect.Bottom;
    memBitmap.Width  := ClientRect.Right;
    memBitmap.Canvas.Font := Self.Font;

    if FState in [bsDown, bsExclusive] then
      Offset := Point(1, 1)
    else
      Offset := Point(0, 0);

    CalcButtonLayout(memBitmap.Canvas, ClientRect, Offset, FLayout, FSpacing,
                     FMargin, FGlyph, FNumGlyphs, Caption, TextBounds, GlyphPos);

    if not Enabled then
    begin
      FState    := bsDisabled;
      FDragging := False;
    end
    else
    begin
      if FState = bsDisabled then
      begin
        if FDown and (GroupIndex <> 0) then
           FState := bsExclusive
        else
           FState := bsUp;
      end;
    end;

    // DrawBackground
    case FTransparent of
      tmAlways:
        DrawParentImage(Self, memBitmap.Canvas);
      tmNone:
        begin
          case FState of
            bsUp:
              if FMouseIn then
                 memBitmap.Canvas.Brush.Color := fColorFocused
              else
                 memBitmap.Canvas.Brush.Color := fColorFlat;
            bsDown:
                 memBitmap.Canvas.Brush.Color := fColorDown;
            bsExclusive:
              if FMouseIn then
                 memBitmap.Canvas.Brush.Color := fColorFocused
              else
                 memBitmap.Canvas.Brush.Color := fColorDown;
            bsDisabled:
                 memBitmap.Canvas.Brush.Color := fColorFlat;
          end;
          memBitmap.Canvas.FillRect(ClientRect);
        end;
      tmNotFocused:
        if FMouseIn then
        begin
          case FState of
            bsUp:
              if FMouseIn then
                memBitmap.Canvas.Brush.Color := fColorFocused
              else
                memBitmap.Canvas.Brush.Color := fColorFlat;
            bsDown:
              memBitmap.Canvas.Brush.Color := fColorDown;
            bsExclusive:
              if FMouseIn then
                memBitmap.Canvas.Brush.Color := fColorFocused
              else
                memBitmap.Canvas.Brush.Color := fColorDown;
            bsDisabled:
              memBitmap.Canvas.Brush.Color := fColorFlat;
          end;
          memBitmap.Canvas.FillRect(ClientRect);
        end
        else
          DrawParentImage(Self, memBitmap.Canvas);
    end;

    // DrawBorder
    case FState of
      bsUp:
        if FMouseIn then
           DrawButtonBorder(memBitmap.canvas, ClientRect, FColorShadow, 1)
        else
          if FDefault then
             DrawButtonBorder(memBitmap.canvas, ClientRect, FColorBorder, 2)
          else
             DrawButtonBorder(memBitmap.canvas, ClientRect, FColorBorder, 1);
      bsDown, bsExclusive:
        DrawButtonBorder(memBitmap.canvas, ClientRect, FColorShadow, 1);
      bsDisabled:
        DrawButtonBorder(memBitmap.canvas, ClientRect, FColorBorder, 1);
    end;  
    if (FMouseIn)and(fHasFocusFrame) then begin
       with ClientRect do
       begin
        FocusRect := Rect(Left+2,Top+2,Right-2,Bottom-2);
       end;
       memBitmap.Canvas.DrawFocusRect(FocusRect);
    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(memBitmap.canvas, glyphpos.x, glyphpos.y, 0);
      finally
        FImageList.Free;
      end;
      tempGlyph.free;
    end;

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

    // Copy memBitmap to screen
    canvas.CopyRect(ClientRect, memBitmap.canvas, ClientRect);
  finally
    memBitmap.free; // delete the bitmap
  end;
end;

procedure TDefineButton.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 TDefineButton.Loaded;
begin
  inherited Loaded;
  Invalidate;
end;

procedure TDefineButton.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;
    SetFocus;
  end;
end;

procedure TDefineButton.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 TDefineButton.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 TDefineButton.Click;
begin
  if Parent <> nil then begin
     GetParentForm(self).ModalResult := FModalResult;
     SetDown(False);
  end;
  if Assigned(PopupMenu) then
     PopupMenu.PopUp(ClientToScreen(Point(0, Height)).X,
                     ClientToScreen(Point(0, Height)).Y);
  inherited Click;
end;   

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

procedure TDefineButton.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 TDefineButton.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 TDefineButton.SetNumGlyphs(Value: TNumGlyphs);
begin
  if value <> FNumGlyphs then
  begin
    FNumGlyphs := value;
    Invalidate;
  end;
end;

procedure TDefineButton.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 TDefineButton.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 TDefineButton.SetGroupIndex(Value: Integer);
begin
  if FGroupIndex <> Value then
  begin
    FGroupIndex := Value;
    UpdateExclusive;
  end;
end;

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

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

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

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

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

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