tebkgrnd.pas

Do your applications look a little boring? Would you like to get spectacular yet easy to use visual

function TFCBackgroundOptions.GetParentBkgrndForm: TFCBackgroundOptions;
begin
  Result := Self;
  if ParentBkgrndForm and Assigned(Parent) then
    Result := Parent.GetParentBkgrndForm;
end;

function TFCBackgroundOptions.GetParentGlass: TFCBackgroundOptions;
begin
  Result := Self;
  if ParentGlass and Assigned(Parent) then
    Result := Parent.GetParentGlass;
end;

procedure TFCBackgroundOptions.SetParentPicture(const Value: Boolean);
begin
  if FParentPicture <> Value then
  begin
    if Value then
      Picture.Graphic := nil;

    FParentPicture := Value;

    PictureChanged(Self);
  end;
end;

procedure TFCBackgroundOptions.SetParentBkgrndForm(const Value: Boolean);
begin
  if FParentBkgrndForm <> Value then
  begin
    if Value then
    begin
      FBkgrndForm.Free;
      FBkgrndForm := nil;
    end;

    FParentBkgrndForm := Value;

    BkgrndFormChanged(Self);
  end;
end;

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

    GlassChanged(Self);
  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);
end;

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

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

procedure TFCBackgroundOptions.SetGlassTranslucency(const Value: TFCTranslucency);
begin
  FParentGlass       := False;
  FGlassTranslucency := Value;
  GlassChanged(Self);
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;
    if Assigned(Control) then
      Control.Invalidate;
  end;
end;

procedure TFCBackgroundOptions.SetBkgrndFormVisible(Value: Boolean);
begin
  if FBkgrndFormVisible <> Value then
  begin
    FBkgrndFormVisible := Value;
    if Assigned(Control) then
      Control.Invalidate;
  end;
end;

procedure TFCBackgroundOptions.SetGlassVisible(Value: Boolean);
begin
  if FGlassVisible <> Value then
  begin
    FGlassVisible := Value;
    if Assigned(Control) then
      Control.Invalidate;
  end;
end;

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

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

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

procedure TFCBackgroundOptions.SetPictureTranspColor(Value: TColor);
begin
  if FPictureTranspColor <> Value then
  begin
    FPictureTranspColor := Value;
    PictureChanged(Self);
  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);
var
  i: Integer;
begin
  for i:= 0 to FChildBkOptions.Count-1 do
  begin
    if TFCBackgroundOptions(ChildBkOptions[i]).ParentPicture then
      TFCBackgroundOptions(ChildBkOptions[i]).PictureChanged(Self);
  end;

  Changed;
end;

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

  Changed;
end;

procedure TFCBackgroundOptions.GlassChanged(Sender: TObject);
var
  i: Integer;
begin
  for i:= 0 to FChildBkOptions.Count-1 do
  begin
    if TFCBackgroundOptions(ChildBkOptions[i]).ParentGlass then
      TFCBackgroundOptions(ChildBkOptions[i]).GlassChanged(Self);
  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(BkOptions: TFCBackgroundOptions; CtrlThis: TControl): TRect;
var
  MaxWidth,
  MaxHeight,
  ClientWidth,
  ClientHeight,
  OffsetH,
  OffsetV: Integer;
  ClientRect: TRect;
  ScrollInfoH,
  ScrollInfoV: TScrollInfo;
  Pic: TPicture;
  CtrlOrg: TWinControl;
  CtrlOrgHandle,
  CtrlThisHandle: HWND;
  IsMDIClient,
  ScrollBarVisible: Boolean;
begin
  Pic            := BkOptions.Picture;
  CtrlOrg        := TWinControl(BkOptions.Control);
  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, ClientRect);
  ClientWidth  := ClientRect.Right  - ClientRect.Left;
  ClientHeight := ClientRect.Bottom - ClientRect.Top;

  if(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);
      ClientWidth  := ScrollInfoH.nMax;
      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);
      ClientHeight := ScrollInfoV.nMax;
      OffsetV      := ScrollInfoV.nPos;
    end;

    ClientRect := Rect(0, 0, ClientWidth, ClientHeight);
    case BkOptions.PictureMode of
      fcpmCenter: Result := Rect((ClientWidth - Pic.Width) DIV 2,
                     (ClientHeight - Pic.Height) DIV 2,
                    ((ClientWidth  - Pic.Width ) DIV 2) + Pic.Width,
                    ((ClientHeight - Pic.Height) DIV 2) + Pic.Height);
      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;
        Result.Top    := (ClientHeight - MaxHeight) DIV 2;
        Result.Right  := Result.Left + MaxWidth;
        Result.Bottom := Result.Top  + MaxHeight;
      end;
      fcpmStretch,
      fcpmTile: Result := ClientRect;
    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, Control);
      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
  PictureChanged   (Sender);
  BkgrndFormChanged(Sender);
  GlassChanged     (Sender);
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: Boolean;
begin
  if BkOptions.Control is TWinControl
  then WndHandle := TWinControl(BkOptions.Control).Handle
  else WndHandle := 0;
  RAux := R;