flatboxs.pas

comerose_flatstyle_v4.42.9.0_d7.rar

  FTransparent  := True;
  SetBounds(0, 0, 121, 15);
end;

procedure TDefineCheckBox.SetColors(Index: Integer; Value: TColor);
begin
  case Index of
    0: FFocusedColor := Value;
    1: FDownColor    := Value;
    2: FCheckedColor   := Value;
    3: FBorderColor  := Value;
  end;
  Invalidate;
end;

procedure TDefineCheckBox.SetLayout(Value: TLayoutPosition);
begin
  FLayout := Value;
  Invalidate;
end;

procedure TDefineCheckBox.SetChecked(Value: Boolean);
begin
  if FChecked <> Value then
  begin
    FChecked := Value;
    Click;
    Invalidate;
    if csDesigning in ComponentState then
      if(GetParentForm(self) <> nil) and(GetParentForm(self).Designer <> nil) then
        GetParentForm(self).Designer.Modified;
  end;
end;

procedure TDefineCheckBox.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  if not Enabled then
  begin
    FMouseIn    := False;
    FMouseDown := False;
  end;
  Invalidate;
end;

procedure TDefineCheckBox.CMTextChanged(var Message: TWmNoParams);
begin
  inherited;
  Invalidate;
end;

procedure TDefineCheckBox.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(Message.CharCode, Caption) and CanFocus then
    begin
      SetFocus;
      if Checked then
         Checked := False
      else
         Checked := True;
      Result := 1;
    end
    else
      if(CharCode = VK_SPACE) and Focused then
      begin
        if Checked then
           Checked := False
        else
           Checked := True;
      end
      else
        inherited;
end;

procedure TDefineCheckBox.CNCommand(var Message: TWMCommand);
begin
  if Message.NotifyCode = BN_CLICKED then Click;
end;

procedure TDefineCheckBox.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if not(csDesigning in ComponentState) and Enabled then
  begin
    Focused := True;
    invalidate;
  end;
end;

procedure TDefineCheckBox.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  if not(csDesigning in ComponentState) and Enabled then
  begin
    FMouseIn := False;
    Focused  := False;
    invalidate;
  end;
end;

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

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

procedure TDefineCheckBox.DoEnter;
begin
  inherited DoEnter;
  Focused := True;
  invalidate;
end;

procedure TDefineCheckBox.DoExit;
begin
  inherited DoExit;
  Focused := False;
  invalidate;
end;

procedure TDefineCheckBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if(Button = mbLeft) and Enabled then
  begin
    SetFocus;
    FMouseDown := true;
    invalidate;
  end;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TDefineCheckBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if(Button = mbLeft) and Enabled then
  begin
    FMouseDown := false;
    if FMouseIn then
      if Checked then
         Checked := False
      else
         Checked := True;
    invalidate;
  end;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TDefineCheckBox.Paint;
var
  TextBounds, CheckRect: TRect;
  Format: UINT;
  TextAs:Integer;
begin
  with Canvas do
  begin
    Lock;
    Font.Assign(self.Font);
    Width  := TextWidth(Caption)+20;
    Height := TextHeight(Caption)+2;
    if FTransparent then
       DrawParentImage(Self, Canvas)
    else
    begin
       Brush.Color := self.Color;
       FillRect(ClientRect);
    end;
    //draw Background
    with ClientRect do
    begin
     case FLayout of
      lpLeft: CheckRect := Rect(Left + 1,   Top + 1, Left + 13, Top + 13);
     lpRight: CheckRect := Rect(Right - 13, Top + 1, Right - 1, Top + 13);
     end;
    end;
    Pen.style := psSolid;
    Pen.width := 1;
    if (Focused or FMouseIn)and(not(csDesigning in ComponentState)) then
    begin
     if (not FMouseDown) then
     begin
        Brush.color := FFocusedColor;
        Pen.color   := FBorderColor;
     end else begin
        Brush.color := FDownColor;
        Pen.color   := FBorderColor;
     end;
    end else begin
      Brush.color := self.Color;
      Pen.color   := FBorderColor;
    end;
    FillRect(CheckRect);
    if Checked then
    begin
     if Enabled then
        DrawInCheck(Canvas,CheckRect,FCheckedColor)
     else
        DrawInCheck(Canvas,CheckRect,clBtnShadow);
    end;
    //draw Border
    Brush.color := FBorderColor;
    FrameRect(CheckRect);
    //draw text
    Brush.Style := bsClear;
    Format      := DT_WORDBREAK;
    with ClientRect do
    begin
     TextAs:=(RectHeight(ClientRect)+ CheckRect.top - TextHeight('W')) div 2;
     case FLayout of
      lpLeft: begin
          TextBounds := Rect(Left + 16, Top + TextAs, Right - 1, Bottom - TextAs);
          Format     := Format or DT_LEFT;
      end;
      lpRight: begin
          TextBounds := Rect(Left + 1,  Top + TextAs, Right - 16, Bottom - TextAs);
          Format     := Format or DT_RIGHT;
      end;
     end;
    end;
    if not Enabled then begin
      OffsetRect(TextBounds, 1, 1);
      Font.Color := clBtnHighlight;
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, Format);
      OffsetRect(TextBounds, -1, -1);
      Font.Color := clBtnShadow;
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, Format);
    end
    else
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, Format);
    unLock;
  end;
end;

procedure TDefineCheckBox.SetTransparent(const Value: Boolean);
begin
  if FTransparent <> Value then
  begin
     FTransparent := Value;
     ParentColor  := not Value;
     Invalidate;
  end;
end;

procedure TDefineCheckBox.WMMove(var Message: TWMMove);
begin
  inherited;
  if FTransparent then
     Invalidate;
end;

procedure TDefineCheckBox.WMSize(var Message: TWMSize);
begin
  inherited;
  if FTransparent then
     Invalidate;
end;

procedure TDefineCheckBox.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if not(csDesigning in ComponentState) and
        (GetActiveWindow <> 0) and (not FMouseIn) then
  begin
    FMouseIn := True;
    Invalidate;
  end;
end;

procedure TDefineCheckBox.CMMouseLeave(var Message: TMessage);
begin
 inherited;
 FMouseIn := false;
 Invalidate;
end;

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

{ TDefineGroupBox }

constructor TDefineGroupBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csAcceptsControls, csOpaque];
  FBorderColor := DefaultBorderColor;
  FBackgropStartColor := DefaultColorStart;
  FBackgropStopColor  := DefaultColorStop;
  FBackgropOrien      := bsHorizontal;
  FAlignment          := stLeft;
  SetBounds(0, 0, 185, 105);
end;

procedure GetStyleGroupBox(Value:TAlignmentText; var Result:UINT);
begin
  case Value of
   stLeft   : result := DT_TOP or DT_LEFT   or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;
   stRight  : result := DT_TOP or DT_RIGHT  or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;
   stCenter : result := DT_TOP or DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;
  end;
end;

procedure TDefineGroupBox.Paint;
var
  memBitmap: TBitmap;
  borderRect, textBounds: TRect;
  textHeight, textWidth, TextLeft, TextRight: integer;
  Format: UINT;
begin
  borderRect := ClientRect;
  GetStyleGroupBox(FAlignment,Format);
  memBitmap := TBitmap.Create; // create memory-bitmap to draw flicker-free
  try
    memBitmap.Height := ClientRect.Bottom;
    memBitmap.Width  := ClientRect.Right;
    memBitmap.Canvas.Font := Self.Font;

    textHeight := memBitmap.Canvas.TextHeight(caption);
    textWidth  := memBitmap.Canvas.TextWidth(caption);

    textBounds := Rect(ClientRect.Left + 10, ClientRect.Top, ClientRect.Right - 10, ClientRect.Top + textHeight);

    // Draw Background
    if FTransparent then
       DrawParentImage(Self, memBitmap.Canvas)
    else begin
      if FStyleFace=fsDefault then begin
         memBitmap.Canvas.Brush.Color := Self.Color;
         memBitmap.Canvas.FillRect(ClientRect);
      end else
         DrawBackdrop(memBitmap.Canvas,FBackgropStartColor,FBackgropStopColor,ClientRect,FBackgropOrien);
    end;

    case FAlignment of
     stLeft:
       begin
         TextLeft := ClientRect.left + 5;
         TextRight:= ClientRect.left + 12 + textWidth;
       end;
     stRight:begin
         TextLeft := ClientRect.Right - TextWidth - 15;
         TextRight:= ClientRect.Right - 8;
       end;
    else//stCenter:
         TextRight:= (RectWidth(ClientRect) + textWidth + 5) div 2;
         TextLeft := (RectWidth(ClientRect) - textWidth - 12) div 2;
    end;
    // Draw Border
    memBitmap.Canvas.Pen.Color := FBorderColor;
    case FBorder of
      brFull:
        begin
          memBitmap.Canvas.Polyline([Point(TextLeft, ClientRect.top +(textHeight div 2)),
            Point(ClientRect.left, ClientRect.top +(textHeight div 2)),
            Point(ClientRect.left, ClientRect.bottom-1), Point(ClientRect.right-1, ClientRect.bottom-1),
            Point(ClientRect.right-1, ClientRect.top +(textHeight div 2)),
            Point(TextRight, ClientRect.top +(textHeight div 2))]);
        end;
      brOnlyTopLine:
        begin
            memBitmap.Canvas.Polyline([Point(ClientRect.left + 5, ClientRect.top +(textHeight div 2)), Point(ClientRect.left, ClientRect.top +(Canvas.textHeight(caption) div 2))]);
            memBitmap.Canvas.Polyline([Point(ClientRect.right-1, ClientRect.top +(textHeight div 2)), Point(ClientRect.left + 12 + textWidth, ClientRect.top +(textHeight div 2))]);
        end;
    end;

    // Draw Text
    memBitmap.Canvas.Brush.Style := bsClear;
    if not Enabled then
    begin
      OffsetRect(textBounds, 1, 1);
      memBitmap.Canvas.Font.Color := clBtnHighlight;
      DrawText(memBitmap.Canvas.Handle, PChar(Caption), Length(Caption), textBounds, Format);
      OffsetRect(textBounds, -1, -1);
      memBitmap.Canvas.Font.Color := clBtnShadow;
      DrawText(memBitmap.Canvas.Handle, PChar(Caption), Length(Caption), textBounds, Format);
    end
    else
      DrawText(memBitmap.Canvas.Handle, PChar(Caption), Length(Caption), textBounds, Format);

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

procedure TDefineGroupBox.CMTextChanged(var Message: TWmNoParams);
begin
  inherited;
  Invalidate;
end;

procedure TDefineGroupBox.SetColors(const Index: Integer;
  const Value: TColor);
begin
  case Index of
    0: FBorderColor := Value;
    1: FBackgropStartColor := Value;
    2: FBackgropStopColor := Value;
  end;
  Invalidate;
end;

procedure TDefineGroupBox.SetBorder(const Value: TGroupBoxBorder);
begin
  FBorder := Value;
  Invalidate;
end;