fcpanel.pas

一套及时通讯的原码

end;

destructor TfcCustomGroupBox.Destroy;
begin
  FFrame.Free;
  inherited Destroy;
end;

procedure TfcCustomGroupBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  if IsTransparent then
     Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TfcCustomGroupBox.AlignControls(AControl: TControl; var Rect: TRect);
begin
  inherited;
  if IsTransparent then Invalidate;
end;

procedure TfcCustomGroupBox.WMEraseBkGnd(var Message: TWMEraseBkGnd);
begin
  if IsTransparent then Message.result:=1
  else if not Frame.IsFrameEffective then inherited
//  else message.result:=1
  else if Frame.IsFrameEffective and
       (Frame.NonFocusColor<>clNone) then message.result:=1
  else if BorderAroundLabel then message.result:=1 // Don't paint outside text if true
  else inherited;
end;

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

procedure TfcCustomGroupBox.ClipChildren(Value: Boolean);
begin
  if (Parent <> nil) then
  begin
      SetWindowLong(Parent.Handle, GWL_STYLE,
        GetWindowLong(Parent.Handle, GWL_STYLE) and not WS_CLIPCHILDREN);
      if HandleAllocated then
        SetWindowLong(Handle, GWL_STYLE,
          GetWindowLong(Handle, GWL_STYLE) and not WS_CLIPCHILDREN);
  end;
end;

procedure TfcCustomGroupBox.SetParent(AParent:TWinControl);
begin
  inherited SetParent(AParent);

  // Without this, the panel would be transparent indeed, but you would see through the form into the background apps
//  ClipChildren(not FTransparent);
end;

procedure TfcCustomGroupBox.CMTextChanged(var Message: TMessage);
begin
  if (not (csDesigning in ComponentState)) or FTransparent then
     Frame.RefreshTransparentText(True);
  inherited;
end;


procedure TfcCustomGroupBox.Invalidate;
var TempRect:TRect;
    r: TRect;
begin
  if IsTransparent and (Parent <> nil) and Parent.HandleAllocated then
  begin
    GetUpdateRect(Handle, r, False);
    tempRect:= BoundsRect;
    tempRect:= Rect(TempRect.Left + r.Left, TempRect.Top + r.Top,
                    TempRect.Left + r.Right, TempRect.Top + R.Bottom);
    InvalidateRect(Parent.Handle, @TempRect, False);


   // 10/23/01 - The following code causes a transpareant panel to not be transparent in some cases
   // when the form first comes up.  In fact only 1 panel seems to exhibit this problem
   // when having multiple panels or groupboxes.

  {    if not fcIsTransparentParent(self) then
       Parent.Update; // Seems necessary for transparent panel in transparent panel when
                      // using splitter between two panels
}
    if (r.left=r.right) and (r.top=r.bottom) then
//      InvalidateRect(Handle, nil, False)  // 7/11/01 - If this code there than 1stclass combos in us cause flicker when dropped-down
    else InvalidateRect(Handle, @r, False);
  end
  else inherited Invalidate;
end;

procedure TfcCustomGroupBox.SetTransparent(Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;

    if IsTransparent then ControlStyle := ControlStyle - [csOpaque]
    else begin
       ControlStyle := ControlStyle + [csOpaque];
    end;

    if not (csLoading in ComponentState) and HandleAllocated and
       not (csDesigning in ComponentState) then
    begin
      Invalidate;
      ClipChildren(not Value);
      RecreateWnd;
    end
  end;
end;

procedure TfcCustomGroupBox.SetCaptionIndent(Value:Integer);
begin
   if FCaptionIndent <> Value then begin
      FCaptionIndent := fcMax(3,Value);
      Invalidate; // 11/1/2001 - PYW - Invalidate Whole thing.
 //   if (not (csDesigning in ComponentState)) or FTransparent then
 //      Frame.RefreshTransparentText(True);
   end;
end;

procedure TfcCustomGroupBox.SetFullBorder(Value:Boolean);
begin
   if FFullBorder <> Value then begin
      FFullBorder := Value;
      Invalidate; // 11/1/2001 - PYW - Invalidate Whole thing.
//      if (not (csDesigning in ComponentState)) or FTransparent then
//         Frame.RefreshTransparentText(True);
   end;
end;

Function TfcCustomGroupBox.IsTransparent: boolean;
begin
   result:= FTransparent and not (csDesigning in ComponentState);
end;

procedure TfcCustomGroupBox.CreateWnd;
begin
   inherited;
   ClipChildren(not FTransparent);
end;

procedure TfcCustomPanel.CreateWnd;
begin
   inherited;
   ClipChildren(not FTransparent);
end;

procedure TfcCustomGroupBox.Paint;
var
  H: Integer;
  TempRect, R, TextR, FillR: TRect;
  Flags,Pad: Longint;
  Text: string;
  StartText, EndText: integer;

  Function GetRect: TRect;
  begin
     with Canvas do begin
       Font := Self.Font;
       if Text = '' then
         H:= 2
       else begin
          if BorderAroundLabel then
             H := TextHeight('0') + 2 // Add 2 if we are showing border around caption
          else H := TextHeight('0');
       end;
//       if FullBorder and BorderAroundLabel then
       if FullBorder then begin
          if BorderAroundLabel then
             Result := Rect(0, H - 2, Width, Height)
          else Result := Rect(0, H+1, Width, Height);
       end
       else Result := Rect(0, H div 2 - 1, Width, Height);
     end;
  end;

begin
   Text:= Caption;
   if Text='' then exit;

   if text = '' then
      H:= 2
   else
      H:= Canvas.TextHeight('0');

   Pad:=1;

   if not UseRightToLeftAlignment then
     TextR := Rect(CaptionIndent, 0, 0, H)
   else
     TextR := Rect(R.Right - Canvas.TextWidth(Text) - CaptionIndent, 0, 0, H);

   with Canvas do begin
     R:= GetRect;

     if Text = '' then begin
        StartText:= 0;
        EndText:= 0;
     end
     else begin
        StartText:= TextR.Left;
        EndText:= TextR.Left + Canvas.TextWidth(Text);
     end;

     if Frame.IsFrameEffective then
     begin
        if (Frame.NonFocusColor<>clNone) and (not FFocused) then
            Brush.Color := Frame.NonFocusColor
        else Brush.Color := Color;
     end
     else Brush.Color:= Color;

     TempRect:= TextR;
     TempRect.Bottom := TempRect.Bottom+1;
     TempRect.Left:= StartText-3;
     TempRect.Right:= EndText+2;
     if not Transparent then begin
        FillR := r;
        InflateRect(FillR,-1,-1);
        FillRect(FillR);
     end;

     if BorderAroundLabel then
     begin
       if not Transparent then
          FillRect(TempRect);
       Brush.Color := clBtnHighlight;
       Pen.Color:= clBtnHighlight;
       PolyLine([Point(StartText-2, r.Top+1), Point(StartText-2, 1),
                 Point(EndText+2, 1), Point(EndText+2, r.Top)]);

//       PolyLine([Point(StartText-3, r.Top), Point(StartText-3, TextR.Bottom+1),
//                 Point(EndText+2, Textr.Bottom+1), Point(EndText+2, Textr.Top)]);

       Brush.Color := clBtnShadow;
       Pen.Color:= clBtnShadow;
       PolyLine([Point(StartText-3, r.Top), Point(StartText-3, 0),
                 Point(EndText+1, 0), Point(EndText+1, r.Top+1)]);

//       PolyLine([Point(StartText-2, r.Top+1), Point(StartText-2, TextR.Bottom),
//                 Point(EndText+1, TextR.Bottom), Point(EndText+1, r.Top+1)]);
     end
     else if FullBorder then begin
       Pad := 0;
       Brush.Color := clBtnHighlight;
       Pen.Color:= clBtnHighlight;
       PolyLine([Point(StartText-2, r.Top+1), Point(EndText+1, r.Top+1)]);

       Brush.Color := clBtnShadow;
       Pen.Color:= clBtnShadow;
       PolyLine([Point(StartText-3, r.Top), Point(EndText+2, r.Top)]);
     end;
     if Ctl3D then
     begin
       Inc(R.Left);
       Inc(R.Top);
       Brush.Color := clBtnHighlight;
       Pen.Color:= clBtnHighlight;
       if Text = '' then begin
          PolyLine([Point(0, r.top), Point(r.left, r.top), Point(r.left, r.bottom-1),
                 Point(r.right-1, r.bottom-1), Point(r.right-1, r.top),
                 Point(0, r.top)]);
       end
       else begin
          PolyLine([Point(TextR.Left-3, r.top), Point(r.left, r.top), Point(r.left, r.bottom-1),
                 Point(r.right-1, r.bottom-1), Point(r.right-1, r.top),
                 Point(TextR.Left + Canvas.TextWidth(Text)+Pad, r.top)]);

       end;
       OffsetRect(R, -1, -1);
       Brush.Color := clBtnShadow;
       Pen.Color:= clBtnShadow;
     end else
       Brush.Color := clWindowFrame;

     PolyLine([Point(StartText-3, r.top), Point(r.left, r.top), Point(r.left, r.bottom-1),
                 Point(r.right-1, r.bottom-1), Point(r.right-1, r.top),
                 Point(EndText+1, r.top)]);

   end;

   if not UseRightToLeftAlignment then
     R := Rect(CaptionIndent, 0, 0, H)
   else
     R := Rect(R.Right - Canvas.TextWidth(Text) - CaptionIndent, 0, 0, H);
   Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);

   if text = '' then exit;
   if BorderAroundLabel then R.Top:= R.Top + 1;

   Canvas.Font.Color:= Font.Color;
   if Frame.IsFrameEffective then
   begin
      if (Frame.NonFocusFontColor<>clNone) and (not FFocused) then
         Canvas.Font.Color := Frame.NonFocusFontColor
   end;

   with Canvas do begin
      SetBkMode(Handle, windows.TRANSPARENT);
      DrawText(Handle, PChar(Text), Length(Text), R, Flags or DT_CALCRECT);
      SetBkMode(Handle, windows.TRANSPARENT);
      DrawText(Handle, PChar(Text), Length(Text), R, Flags);
   end
end;

{
procedure TfcCustomGroupBox.Paint;
var
  H: Integer;
  R: TRect;
  Flags: Longint;
begin
  with Canvas do
  begin
    Font := Self.Font;
    H := TextHeight('0');
    R := Rect(0, H div 2 - 1, Width, Height);
    if Ctl3D then
    begin
      Inc(R.Left);
      Inc(R.Top);
      Brush.Color := clBtnHighlight;
      FrameRect(R);
      OffsetRect(R, -1, -1);
      Brush.Color := clBtnShadow;
    end else
      Brush.Color := clWindowFrame;
    FrameRect(R);
    if Text <> '' then
    begin
      if not UseRightToLeftAlignment then
        R := Rect(8, 0, 0, H)
      else                         
        R := Rect(R.Right - Canvas.TextWidth(Text) - 8, 0, 0, H);
      Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
      DrawText(Handle, PChar(Text), Length(Text), R, Flags or DT_CALCRECT);
      Brush.Color := Color;
      Brush.Style := bsClear;
      DrawText(Handle, PChar(Text), Length(Text), R, Flags);
    end;
  end;
end;
}

function TfcCustomPanel.InvalidateNeeded:boolean;
begin
  result := False;
  if Frame.Enabled then
    if (Frame.NonFocusColor <> clNone) then begin
       if (Color <> Frame.NonFocusColor) then result := True;
    end
    else if (Frame.NonFocusFontColor <> clNone) then begin
       if (Font.Color <> Frame.NonFocusFontColor) then result := True;
    end;
end;

procedure TfcCustomPanel.CMEnter(var Message: TCMEnter);
var r,r2:TRect;
begin
   inherited;
   FFocused:= True;
   if invalidateneeded then invalidate;

   if Frame.Enabled then
   if (Frame.FocusBorders * Frame.NonFocusBorders <> Frame.FocusBorders) or
      (Frame.FocusStyle <> Frame.NonFocusStyle) then
   begin
     r:= ClientRect;
     r2:= Rect(r.left+2,r.top+2,r.right-2,r.bottom-2);
     ValidateRect(handle,@r2);
     InvalidateRect(handle, @r, False);
   end;
end;

procedure TfcCustomPanel.CMExit(var Message: TCMExit);
var r,r2:Trect;
begin
   inherited;
   FFocused:= False;
   if invalidateneeded then invalidate;

   if Frame.Enabled then
   if (Frame.FocusBorders * Frame.NonFocusBorders <> Frame.FocusBorders) or
      (Frame.FocusStyle <> Frame.NonFocusStyle) then
   begin
     r:= ClientRect;
     r2:= Rect(r.left+2,r.top+2,r.right-2,r.bottom-2);
     ValidateRect(handle,@r2);
     InvalidateRect(handle, @r, False);
   end;
end;

procedure TfcCustomGroupBox.CMEnter(var Message: TCMEnter);
begin
   inherited;
   FFocused:= True;
   if InvalidateNeeded then invalidate;
end;

function TfcCustomGroupBox.InvalidateNeeded:boolean;
begin
  result := False;
  if Frame.Enabled then
    if (Frame.NonFocusColor <> clNone) then begin
       if (Color <> Frame.NonFocusColor) then result := True;
    end
    else if (Frame.NonFocusFontColor <> clNone) then begin
       if (Font.Color <> Frame.NonFocusFontColor) then result := True;
    end;
end;

procedure TfcCustomGroupBox.CMExit(var Message: TCMExit);
begin
   inherited;
   FFocused:= False;
   if InvalidateNeeded then invalidate;
end;

end.