flatpanel.pas

comerose_flatstyle_v4.42.9.0_d7.rar

      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;

    // Draw Border
    DrawButtonBorder(memBitmap.Canvas, ClientRect, FColorBorder, 1);

    // Draw Text
    memBitmap.Canvas.Font := Self.Font;
    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 TDefinePanel.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

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

procedure TDefinePanel.SetTransparent(const Value: Boolean);
begin
  FTransparent := Value;
  Invalidate;
end;

procedure TDefinePanel.SetBackgropOrien(const Value: TStyleOrien);
begin
  FBackgropOrien := Value;
  Invalidate;
end;

procedure TDefinePanel.SetStyleFace(const Value: TStyleFace);
begin
  FStyleFace := Value;
  Invalidate;
end;

procedure TDefinePanel.SetAlignment(const Value: TAlignment);
begin
  FAlignment := Value;
  Invalidate;
end;

procedure TDefinePanel.CMIsToolControl(var Message: TMessage);
begin
  if not FLocked then Message.Result := 1;
end;

procedure TDefinePanel.WMWindowPosChanged(var Message: TWMWindowPosChanged);
var
  Rect: TRect;
begin
  if FullRepaint or (Caption <> '') then
     Invalidate
  else
  begin
    Rect.Right := Width;
    Rect.Bottom := Height;
    if Message.WindowPos^.cx <> Rect.Right then
    begin
       Rect.Top := 0;
       Rect.Left := Rect.Right - 2;
       InvalidateRect(Handle, @Rect, True);
    end;
    if Message.WindowPos^.cy <> Rect.Bottom then
    begin
       Rect.Left := 0;
       Rect.Top := Rect.Bottom - 2;
       InvalidateRect(Handle, @Rect, True);
    end;
  end;
  inherited;
end;

procedure TDefinePanel.CMDockClient(var Message: TCMDockClient);
var
  R: TRect;
  Dim: Integer;
begin
  if AutoSize then
  begin
    FAutoSizeDocking := True;
    try
      R := Message.DockSource.DockRect;
      case Align of
        alLeft: if Width = 0 then Width := R.Right - R.Left;
        alRight: if Width = 0 then
          begin
            Dim := R.Right - R.Left;
            SetBounds(Left - Dim, Top, Dim, Height);
          end;
        alTop: if Height = 0 then Height := R.Bottom - R.Top;
        alBottom: if Height = 0 then
          begin
            Dim := R.Bottom - R.Top;
            SetBounds(Left, Top - Dim, Width, Dim);
          end;
      end;
      inherited;
      Exit;
    finally
      FAutoSizeDocking := False;
    end;
  end;
  inherited;
end;

function TDefinePanel.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
  Result := (not FAutoSizeDocking) and inherited CanAutoSize(NewWidth, NewHeight);
end;

function TDefinePanel.GetControlsAlignment: TAlignment;
begin
  Result := FAlignment;
end;

procedure TDefinePanel.SetParentBackground(Value: Boolean);
begin
  { TCustomPanel needs to not have csOpaque when painting
    with the ParentBackground in Themed applications }
  if Value then
    ControlStyle := ControlStyle - [csOpaque]
  else
    ControlStyle := ControlStyle + [csOpaque];
  FParentBackgroundSet := True;
  inherited;
end;

procedure TDefinePanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  end; 
end;

procedure TDefinePanel.AdjustClientRect(var Rect: TRect);
begin
  inherited AdjustClientRect(Rect);
  InflateRect(Rect, -1, -1);
end;

{ TFlatTicket }

constructor TFlatTicket.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Name := 'Label';  { do not localize }
  SetSubComponent(True);
  if Assigned(AOwner) then
     Caption := AOwner.Name;
end;

procedure TFlatTicket.AdjustBounds;
begin
  inherited AdjustBounds;
  if Owner is TFlatLBPanel then
    with Owner as TFlatLBPanel do
      SetTicketPosition(TicketPosition);
end;

function TFlatTicket.GetHeight: Integer;
begin
  Result := inherited Height;
end;

function TFlatTicket.GetLeft: Integer;
begin
  Result := inherited Left;
end;

function TFlatTicket.GetTop: Integer;
begin
  Result := inherited Top;
end;

function TFlatTicket.GetWidth: Integer;
begin
  Result := inherited Width;
end;

procedure TFlatTicket.SetHeight(const Value: Integer);
begin
  SetBounds(Left, Top, Width, Value);
end;

procedure TFlatTicket.SetWidth(const Value: Integer);
begin
  SetBounds(Left, Top, Value, Height);
end;
{ TFlatLBPanel }
procedure TFlatLBPanel.CMEnabledChanged (var Message: TMessage);
begin
  inherited;
  if Assigned(FTicket) then FTicket.Enabled := Enabled;
end;

procedure TFlatLBPanel.SetTicketPosition(const Value: TTicketPosition);
begin
  if FTicket = nil then exit;
  FTicketPosition := Value;
  SetTicketPoint(Value,Self,Ticket,FTicketSpace);
end;

procedure TFlatLBPanel.SetLabelSpacing(const Value: Integer);
begin
  if Assigned(FTicket) then FTicketSpace := Value;
  SetTicketPosition(FTicketPosition);
end;

procedure TFlatLBPanel.SetupInternalLabel;
begin
  if DefaultHasTicket then begin
   if Assigned(FTicket) then exit;
   FTicket := TFlatTicket.Create(Self);
   FTicket.FreeNotification(Self);
   FTicket.Transparent  := True;
   FTicket.FocusControl := Self;
  end;
end;

procedure TFlatLBPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  SetTicketPosition(FTicketPosition);
end;

procedure TFlatLBPanel.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if FTicket = nil then exit;
  FTicket.Parent := AParent;
  FTicket.Visible := True;
end;

procedure TFlatLBPanel.CMBidimodechanged(var Message: TMessage);
begin
  inherited;
  if Assigned(FTicket) then FTicket.BiDiMode := BiDiMode;
end;

procedure TFlatLBPanel.CMVisiblechanged(var Message: TMessage);
begin
  inherited;
  if Assigned(FTicket) then FTicket.Visible := Visible;
end;

procedure TFlatLBPanel.SetName(const Value: TComponentName);
begin
  if Assigned(FTicket) then begin
   if (csDesigning in ComponentState) and ((FTicket.GetTextLen = 0) or
      (CompareText(FTicket.Caption, Name) = 0)) then
       FTicket.Caption := Value;
  end;
  inherited SetName(Value);
  if (csDesigning in ComponentState)and(Assigned(FTicket)) then
     Caption := '';
end;

procedure TFlatLBPanel.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FTicket) and (Operation = opRemove) then
     FTicket := nil;
end;

constructor TFlatLBPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTicketPosition   := poLeft;
  FTicketSpace      := 3;
  SetupInternalLabel;
end;

end.