tebkgrnd.pas

delphi2007界面效果控件源码

    FParentBkgrndForm := Value;

    BkgrndFormChanged(Self, True);
  end;
end;

procedure TFCBackgroundOptions.SetParentGlass(const Value: Boolean);
begin
  if FParentGlass <> Value then
  begin
    FParentGlass := Value;

    GlassChanged(Self, True);
  end;
end;

function TFCBackgroundOptions.GetPicture: TPicture;
begin
  Result := GetParentPicture.FPicture;
end;

function TFCBackgroundOptions.GetBkgrndForm: TCustomForm;
begin
  Result := GetParentBkgrndForm.FBkgrndForm;
end;

function TFCBackgroundOptions.GetGlassColor: TColor;
begin
  Result := GetParentGlass.FGlassColor;
end;

function TFCBackgroundOptions.GetGlassTranslucency: TFCTranslucency;
begin
  Result := GetParentGlass.FGlassTranslucency;
end;

procedure TFCBackgroundOptions.SetPicture(const Value: TPicture);
begin
  FParentPicture := False;
  FPicture.Assign(Value);
end;

procedure TFCBackgroundOptions.SetBkgrndForm(Value: TCustomFormClass);
begin
  FParentBkgrndForm := False;
  FBkgrndForm.Free;
  FBkgrndForm := nil;
  if Value <> nil then
  begin
    FBkgrndForm := Value.Create(Control);
    TFCCustomForm(FBkgrndForm).BorderStyle := bsNone;
    FBkgrndForm.Left := 0;
    FBkgrndForm.Top  := 0;
    FBkgrndForm.SetBounds(-1, -1, Control.ClientWidth, Control.ClientHeight);
    SetWindowRgn(FBkgrndForm.Handle, CreateRectRgn(0, 0, 1, 1), False);
    ShowWindow(FBkgrndForm.Handle, SW_SHOWNOACTIVATE);
    FBkgrndForm.Visible := True;
  end;

  BkgrndFormChanged(Self, True);
end;

function TFCBackgroundOptions.GlassTranslucencyToUse: TFCTranslucency;
begin
  Result := GlassTranslucency;
end;

procedure TFCBackgroundOptions.SetGlassColor(const Value: TColor);
begin
  FParentGlass := False;
  FGlassColor  := Value;
  GlassChanged(Self, True);
end;

procedure TFCBackgroundOptions.SetGlassTranslucency(const Value: TFCTranslucency);
begin
  FParentGlass       := False;
  FGlassTranslucency := Value;
  GlassChanged(Self, True);
end;

function TFCBackgroundOptions.IsPictureStored: Boolean;
begin
  Result := not ParentPicture;
end;

function TFCBackgroundOptions.IsGlassStored: Boolean;
begin
  Result := not ParentGlass;
end;

procedure TFCBackgroundOptions.SetPictureVisible(Value: Boolean);
begin
  if FPictureVisible <> Value then
  begin
    FPictureVisible := Value;
    PicChanged(Self, False);
  end;
end;

procedure TFCBackgroundOptions.SetBkgrndFormVisible(Value: Boolean);
begin
  if FBkgrndFormVisible <> Value then
  begin
    FBkgrndFormVisible := Value;
    BkgrndFormChanged(Self, False);
  end;
end;

procedure TFCBackgroundOptions.SetGlassVisible(Value: Boolean);
begin
  if FGlassVisible <> Value then
  begin
    FGlassVisible := Value;
    GlassChanged(Self, False);
  end;
end;

function TFCBackgroundOptions.GetPictureMode: TFCPictureMode;
begin
  Result := GetParentPicture.FPictureMode;
end;

procedure TFCBackgroundOptions.SetPictureMode(Value: TFCPictureMode);
begin
  if FPictureMode <> Value then
  begin
    FPictureMode := Value;
    PicChanged(Self, True);
  end;
end;

function TFCBackgroundOptions.GetPictureTranspColor: TColor;
begin
  Result := GetParentPicture.FPictureTranspColor;
end;

procedure TFCBackgroundOptions.SetPictureTranspColor(Value: TColor);
begin
  if FPictureTranspColor <> Value then
  begin
    FPictureTranspColor := Value;
    PicChanged(Self, True);
  end;
end;

procedure TFCBackgroundOptions.OpaqueChanged(Sender: TObject);
var
  i: Integer;
begin
  for i:= 0 to FChildBkOptions.Count-1 do
  begin
    if TFCBackgroundOptions(ChildBkOptions[i]).ParentOpaque then
      TFCBackgroundOptions(ChildBkOptions[i]).OpaqueChanged(Self);
  end;

  Changed;
end;

procedure TFCBackgroundOptions.PictureChanged(Sender: TObject);
begin
  PicChanged(Sender, True);
end;

procedure TFCBackgroundOptions.PicChanged(Sender: TObject; Propagate: Boolean);
var
  i: Integer;
begin
  if Propagate then
  begin
    for i:= 0 to FChildBkOptions.Count-1 do
    begin
      if TFCBackgroundOptions(ChildBkOptions[i]).ParentPicture then
        TFCBackgroundOptions(ChildBkOptions[i]).PicChanged(Self, True);
    end;
  end;

  Changed;
end;

procedure TFCBackgroundOptions.BkgrndFormChanged(Sender: TObject;
  Propagate: Boolean);
var
  i: Integer;
begin
  if Propagate then
  begin
    for i:= 0 to FChildBkOptions.Count-1 do
    begin
      if TFCBackgroundOptions(ChildBkOptions[i]).ParentBkgrndForm then
        TFCBackgroundOptions(ChildBkOptions[i]).BkgrndFormChanged(Self, True);
    end;
  end;

  Changed;
end;

procedure TFCBackgroundOptions.GlassChanged(Sender: TObject;
  Propagate: Boolean);
var
  i: Integer;
begin
  if Propagate then
  begin
    for i:= 0 to FChildBkOptions.Count-1 do
    begin
      if TFCBackgroundOptions(ChildBkOptions[i]).ParentGlass then
        TFCBackgroundOptions(ChildBkOptions[i]).GlassChanged(Self, True);
    end;
  end;

  Changed;
end;

function TFCBackgroundOptions.IsOpaqueActive: Boolean;
begin
  Result := Opaque;
end;

function TFCBackgroundOptions.IsPictureActive: Boolean;
var
  Pic: TPicture;
begin
  Result := PictureVisible;
  if Result then
  begin
    Pic := Picture;
    Result :=
      (Pic.Graphic <> nil)     and
      (not Pic.Graphic.Empty)  and
      (Pic.Graphic.Width  > 0) and
      (Pic.Graphic.Height > 0);
  end;
end;

function TFCBackgroundOptions.IsBkFormActive: Boolean;
begin
  Result := BkgrndFormVisible and (BkgrndForm <> nil);
end;

function TFCBackgroundOptions.IsGlassActive: Boolean;
begin
  Result := GlassVisible and (GlassTranslucencyToUse < 255);
end;

function PictureRect(Pic: TGraphic; PictureMode: TFCPictureMode; Margin: Word;
  CtrlThis: TControl; CtrlOrg: TWinControl; var DrawRect: TRect): TRect;
var
  MaxWidth,
  MaxHeight,
  ClientWidth,
  ClientHeight,
  OffsetH,
  OffsetV: Integer;
  ScrollInfoH,
  ScrollInfoV: TScrollInfo;
  CtrlOrgHandle,
  CtrlThisHandle: HWND;
  IsMDIClient,
  ScrollBarVisible: Boolean;
begin
  IsMDIClient    :=
    (CtrlOrg is TCustomForm) and
    (TFCCustomForm(CtrlOrg).FormStyle = fsMDIForm);
  CtrlThisHandle := TWinControl(CtrlThis).Handle;
  if not IsMDIClient
  then CtrlOrgHandle := CtrlOrg.Handle
  else
  begin
    CtrlOrgHandle  := TFCCustomForm(CtrlOrg).ClientHandle;
    if CtrlThis = CtrlOrg then
      CtrlThisHandle := CtrlOrgHandle;
  end;
  GetClientRect(CtrlOrgHandle, DrawRect);
  ClientWidth  := DrawRect.Right  - DrawRect.Left;
  ClientHeight := DrawRect.Bottom - DrawRect.Top;

  if(Pic = nil) or (Pic.Width = 0) or (Pic.Height = 0)
  then Result := Rect(0, 0, 0, 0)
  else
  begin
    OffsetH := 0;
    OffsetV := 0;

    if not IsMDIClient
    then ScrollBarVisible := IsScrollBarVisible(CtrlOrg, CtrlOrgHandle, sbHorizontal)
    else ScrollBarVisible := IsScrollBarVisible(nil    , CtrlOrgHandle, sbHorizontal);
    if ScrollBarVisible then
    begin
      ScrollInfoH.cbSize := SizeOf(ScrollInfoH);
      ScrollInfoH.fMask  := SIF_ALL;
      GetScrollInfo(CtrlOrgHandle, SB_HORZ, ScrollInfoH);
      OffsetH := ScrollInfoH.nPos;
    end;

    if not IsMDIClient
    then ScrollBarVisible := IsScrollBarVisible(CtrlOrg, CtrlOrgHandle, sbVertical)
    else ScrollBarVisible := IsScrollBarVisible(nil    , CtrlOrgHandle, sbVertical);
    if ScrollBarVisible then
    begin
      ScrollInfoV.cbSize := SizeOf(ScrollInfoV);
      ScrollInfoV.fMask  := SIF_ALL;
      GetScrollInfo(CtrlOrgHandle, SB_VERT, ScrollInfoV);
      OffsetV := ScrollInfoV.nPos;
    end;

    DrawRect   := Rect(0, 0, ClientWidth, ClientHeight);
    InflateRect(DrawRect, -Margin, -Margin);
    ClientWidth  := DrawRect.Right  - DrawRect.Left;
    ClientHeight := DrawRect.Bottom - DrawRect.Top;

    case PictureMode of
      fcpmCenter:
      begin
        Result :=
          Rect(
            ((ClientWidth  - Pic.Width ) DIV 2) + Margin,
            ((ClientHeight - Pic.Height) DIV 2) + Margin,
            ((ClientWidth  - Pic.Width ) DIV 2) + Margin + Pic.Width,
            ((ClientHeight - Pic.Height) DIV 2) + Margin + Pic.Height);
      end;
      fcpmCenterStretch:
      begin
        if(ClientWidth / ClientHeight) > (Pic.Width / Pic.Height)
        then
        begin
          MaxHeight := ClientHeight;
          MaxWidth  := (Pic.Width * MaxHeight) DIV Pic.Height;
        end
        else
        begin
          MaxWidth  := ClientWidth;
          MaxHeight := (Pic.Height * MaxWidth) DIV Pic.Width;
        end;
        Result.Left   := ((ClientWidth  - MaxWidth ) DIV 2) + Margin;
        Result.Top    := ((ClientHeight - MaxHeight) DIV 2) + Margin;
        Result.Right  := (Result.Left + MaxWidth );
        Result.Bottom := (Result.Top  + MaxHeight);
      end;
      fcpmStretch,
      fcpmTile,
      fcpmZoom   :
      begin
        Result   := DrawRect;
      end;
      fcpmTopLeft:
      begin
        IntersectRect(
          Result,
          DrawRect,
          Rect(Margin, Margin, Pic.Width + Margin, Pic.Height + Margin));
      end;
    end;

    if CtrlOrgHandle <> CtrlThisHandle then
    begin
      ClientToScreen(CtrlOrgHandle , Result.TopLeft);
      ClientToScreen(CtrlOrgHandle , Result.BottomRight);
      ScreenToClient(CtrlThisHandle, Result.TopLeft);
      ScreenToClient(CtrlThisHandle, Result.BottomRight);
      OffsetRect(Result, -OffsetH, -OffsetV);

      if IsScrollBarVisible(CtrlThis, CtrlThisHandle, sbHorizontal) then
      begin
        ScrollInfoH.cbSize := SizeOf(ScrollInfoH);
        ScrollInfoH.fMask  := SIF_POS;
        GetScrollInfo(CtrlThisHandle, SB_HORZ, ScrollInfoH);
        OffsetRect(Result, ScrollInfoH.nPos, 0);
      end;
      if IsScrollBarVisible(CtrlThis, CtrlThisHandle, sbVertical) then
      begin
        ScrollInfoV.cbSize := SizeOf(ScrollInfoV);
        ScrollInfoV.fMask  := SIF_POS;
        GetScrollInfo(CtrlThisHandle, SB_VERT, ScrollInfoV);
        OffsetRect(Result, 0, ScrollInfoV.nPos);
      end;
    end;
  end;
end;

function TFCBackgroundOptions.XRayActive(
  PictureBkOptions: TFCBackgroundOptions; R: TRect): Boolean;

  function CoveredByPic: Boolean;
  var
    aux,
    PicRect: TRect;
  begin
    Result := PictureActive and (PictureTranspColor = clNone);
    if Result then
    begin
      PicRect := PictureRect(PictureBkOptions.Picture.Graphic,
        PictureBkOptions.PictureMode, 0, Control,
        TWinControl(PictureBkOptions.Control), aux);
      UnionRect(aux, PicRect, R);
      Result  := EqualRect(PicRect, aux);
    end;
  end;

begin
  Result :=
    Assigned(Control.Parent) and
    IsActive                 and
    (not OpaqueActive)       and
    (not BkFormActive)       and
    (not CoveredByPic);
end;

function TFCBackgroundOptions.IsActive: Boolean;
begin
  Result := Assigned(Control);
  if Result then
  begin
    OpaqueActive  := IsOpaqueActive;
    GlassActive   := IsGlassActive;
    PictureActive := IsPictureActive;
    BkFormActive  := IsBkFormActive;
    Result :=
      (not OpaqueActive) or GlassActive or IsBkFormActive or PictureActive;
  end;
end;

procedure TFCBackgroundOptions.ControlChanged(Sender: TObject);
begin
  PicChanged       (Sender, True);
  BkgrndFormChanged(Sender, True);
  GlassChanged     (Sender, True);
end;

procedure DrawXRay(BkOptions: TFCBackgroundOptions; var Bmp: TBitmap;
  R, DrawR: TRect; BmpWidth, BmpHeight: Integer; PixelFormat: TPixelFormat);
var
  WndHandle,
  Limit: HWnd;
  RAux,
  RAux2: TRect;
  P: TPoint;
  SaveClipRgn,
  ClipRgn: HRGN;
  ExistsClipRgn,
  HasUpdateRect,
  SaveTEXPRenderDisabled: Boolean;
begin
  if BkOptions.Control is TWinControl
  then WndHandle := TWinControl(BkOptions.Control).Handle
  else WndHandle := 0;
  RAux := R;
  ClientToScreen(WndHandle, RAux.TopLeft);
  ScreenToClient(BkOptions.Control.Parent.Handle, RAux.TopLeft);
  ClientToScreen(WndHandle, RAux.BottomRight);
  ScreenToClient(BkOptions.Control.Parent.Handle, RAux.BottomRight);

  RAux2 := DrawR;
  LPToDP(Bmp.Canvas.Handle, RAux2, 2);
  SaveClipRgn   := CreateRectRgn(0, 0, 0, 0);
  ExistsClipRgn := GetClipRgn(Bmp.Canvas.Handle, SaveClipRgn) = 1;
  ClipRgn       := CreateRectRgn(RAux2.Left, RAux2.Top, RAux2.Right, RAux2.Bottom);
  SelectClipRgn(Bmp.Canvas.Handle, ClipRgn);
  DeleteObject(ClipRgn);
  try
    OffsetWindowOrgEx(Bmp.Canvas.Handle, RAux.Left-R.Left-(DrawR.Left-R.Left),
      RAux.Top-R.Top-(DrawR.Top-R.Top), P);
    try
      Limit := WndHandle;
      HasUpdateRect:= GetUpdateRect(TWinControl(BkOptions.Control).Handle,
        TRect(nil^), False);
      SaveTEXPRenderDisabled := TEXPRenderDisabled;
      TEXPRenderDisabled     := True;
      try
        RenderWindowToDC(BkOptions.Control.Parent.Handle, Limit,
          BkOptions.Control.Parent, Bmp.Canvas.Handle, RAux, True, False, False,
          True);
      finally
        TEXPRenderDisabled := SaveTEXPRenderDisabled;
        if not HasUpdateRect then
          ValidateRect(TWinControl(BkOptions.Control).Handle, nil);
      end;
    finally
      SetWindowOrgEx(Bmp.Canvas.Handle, P.x, P.y, nil);
    end;
  finally
    if ExistsClipRgn
    then SelectClipRgn(Bmp.Canvas.Handle, SaveClipRgn)
    else SelectClipRgn(Bmp.Canvas.Handle, 0);
    DeleteObject(SaveClipRgn);
  end;
end;

procedure DrawBkgrndForm(BkOptions: TFCBackgroundOptions; Control: TControl;
  var Bmp: TBitmap; R, DrawR: TRect; BmpWidth, BmpHeight: Integer;
  PixelFormat: TPixelFormat);
var
  WndHandle: HWnd;
  RAux,
  RAux2: TRect;
  P: TPoint;
  SaveClipRgn,
  ClipRgn: HRGN;
  SaveTEXPRenderDisabled,
  ExistsClipRgn: Boolean;
  BkForm: TCustomForm;
  ClientWidth,
  ClientHeight,