formskin.pas

GREATIS Print Suite Pro for Delphi (3-7,2005,2006,2007) and C++ Builder (3-6) Set of components for

            DeleteObject(RGN);
          end;
        end;
        TRP:=IsTransparent(X,Y);
      end;
    end;
    if not TRP then
    begin
      RGN:=CreateRectRgn(XStart,Y,GetSkinWidth,Succ(Y));
      try
        with TForm(Owner),ClientOrigin do OffsetRgn(RGN,X-Left,Y-Top);
        CombineRgn(Result,Result,RGN,RGN_OR);
      finally
        DeleteObject(RGN);
      end;
    end;
  end;
end;

function TCustomFormSkin.GetSkinWidth: Integer;
begin
  if Assigned(Owner) then Result:=TForm(Owner).ClientWidth
  else Result:=0;
end;

function TCustomFormSkin.GetSkinHeight: Integer;
begin
  if Assigned(Owner) then Result:=TForm(Owner).ClientHeight
  else Result:=0;
end;

function TCustomFormSkin.IsTransparent(X,Y: Integer): Boolean;
begin
  if Assigned(FOnTransparency) then FOnTransparency(Self,X,Y,Result);
end;

function TCustomFormSkin.IsTransparentControl(Control: TControl): Boolean;
begin
  Result:=False;
  if Assigned(FOnControlTransparency) then
    FOnControlTransparency(Self,Control,Result);
end;

procedure TCustomFormSkin.HookProc(var Message: TMessage);

var
  Command: Word;
  HA: THitArea;
  P: TPoint;

  function CallDefault: Integer;
  begin
    with Message do
      CallDefault:=CallWindowProc(FDefaultProc,TForm(Owner).Handle,Msg,wParam,lParam);
  end;

begin
  if Assigned(Owner) then
    with Message do
      case Msg of
        WM_NCHITTEST:
          if not (csDesigning in ComponentState) then
          begin
            Result:=CallDefault;
            HA:=HitTestToHitArea(Result);
            P:=TForm(Owner).ScreenToClient(Point(LoWord(lParam),HiWord(lParam)));
            HitArea(P.X,P.Y,HA);
            Result:=HitAreaToHitTest(HA);
            if ((Result=HTCLIENT) or (Result=HTNOWHERE)) and (soClientDrag in FOptions) then Result:=HTCAPTION
          end
          else Result:=CallDefault;
        WM_NCLBUTTONDOWN:
          if not (csDesigning in ComponentState) then
          begin
            case wParam of
              HTSYSMENU:
              begin
                if Assigned(FPopupMenu) then FPopupMenu.Popup(LoWord(lParam),HiWord(lParam));
                Exit;
              end;
              HTREDUCE: Command:=SC_MINIMIZE;
              HTZOOM: Command:=SC_MAXIMIZE;
              HTCLOSE: Command:=SC_CLOSE;
            else
            begin
              Result:=CallDefault;
              Exit;
            end;
            end;
            SendMessage(TForm(Owner).Handle,WM_SYSCOMMAND,Command,lParam);
          end
          else Result:=CallDefault;
        WM_GETMINMAXINFO:
          if not (csLoading in ComponentState) and (soAutoSize in FOptions) and not FLockSizeMessages then
            with PMinMaxInfo(lParam)^,TForm(Owner) do
            begin
              ptMinTrackSize.X:=Width;
              ptMinTrackSize.Y:=Height;
              ptMaxTrackSize:=ptMinTrackSize;
            end
          else Result:=CallDefault;
        WM_SIZE:
        begin
          Result:=CallDefault;
          if not FLockSizeMessages then Update;
        end;
      else Result:=CallDefault;
      end;
end;

function TCustomFormSkin.HitAreaToHitTest(Value: THitArea): Integer;
begin
  case Value of
    haClient: Result:=HTCLIENT;
    haCaptionBar: Result:=HTCAPTION;
    haSysMenu: Result:=HTSYSMENU;
    haMinimizeButton: Result:=HTREDUCE;
    haMaximizeButton: Result:=HTZOOM;
    haCloseButton: Result:=HTCLOSE;
    haTopBorder: Result:=HTTOP;
    haBottomBorder: Result:=HTBOTTOM;
    haLeftBorder: Result:=HTLEFT;
    haRightBorder: Result:=HTRIGHT;
    haTopLeftCorner: Result:=HTTOPLEFT;
    haTopRightCorner: Result:=HTTOPRIGHT;
    haBottomLeftCorner: Result:=HTBOTTOMLEFT;
    haBottomRightCorner: Result:=HTBOTTOMRIGHT;
    haGrowBox: Result:=HTGROWBOX;
  else Result:=HTNOWHERE;
  end;
end;

function TCustomFormSkin.HitTestToHitArea(Value: Integer): THitArea;
begin
  case Value of
    HTCLIENT: Result:=haClient;
    HTCAPTION: Result:=haCaptionBar;
    HTSYSMENU: Result:=haSysMenu;
    HTREDUCE: Result:=haMinimizeButton;
    HTZOOM: Result:=haMaximizeButton;
    HTCLOSE: Result:=haCloseButton;
    HTTOP: Result:=haTopBorder;
    HTBOTTOM: Result:=haBottomBorder;
    HTLEFT: Result:=haLeftBorder;
    HTRIGHT: Result:=haRightBorder;
    HTTOPLEFT: Result:=haTopLeftCorner;
    HTTOPRIGHT: Result:=haTopRightCorner;
    HTBOTTOMLEFT: Result:=haBottomLeftCorner;
    HTBOTTOMRIGHT: Result:=haBottomRightCorner;
    HTGROWBOX: Result:=haGrowBox;
  else Result:=haNone;
  end;
end;

destructor TCustomFormSkin.Destroy;
begin
  Active:=False;
  inherited;
end;

procedure TCustomFormSkin.Update;
begin
  if Assigned(Owner) and (Owner is TForm) then
    if not (csDesigning in ComponentState) then
    begin
      if FActive then
      begin
        DeleteObject(FRegion);
        if (soSkin in FOptions) and (soAutoSize in FOptions) then
        begin
          FLockSizeMessages:=True;
          try
            with TForm(Owner) do
            begin
              ClientHeight:=GetSkinHeight;
              ClientWidth:=GetSkinWidth;
            end;
          finally
            FLockSizeMessages:=False;
          end;
        end;
        FRegion:=CreateRegion;
        if FRegion<>0 then SetWindowRgn(TForm(Owner).Handle,FRegion,True);
      end
      else
      begin
        SetWindowRgn(TForm(Owner).Handle,0,True);
        DeleteObject(FRegion);
        FRegion:=0;
      end
    end
    else
    begin
      if (soSkin in FOptions) and (soAutoSize in FOptions) then
      begin
        FLockSizeMessages:=True;
        try
          with TForm(Owner) do
          begin
            ClientHeight:=GetSkinHeight;
            ClientWidth:=GetSkinWidth;
          end;
        finally
          FLockSizeMessages:=False;
        end;
      end;
    end
  else EFormSkinException.Create('Owner of TCustomFormSkin must be derived from TForm.');
end;

procedure TBitmapFormSkin.SetTransparentColor(const Value: TColor);
begin
  if FTransparentColor<>Value then
  begin
    FTransparentColor:=Value;
    Update;
  end;
end;

procedure TBitmapFormSkin.SetSkin(const Value: TBitmap);
begin
  FSkin.Assign(Value);
  Update;
end;

procedure TBitmapFormSkin.SetPreview(const Value: Boolean);
begin
  if FPreview<>Value then
  begin
    FPreview:=Value;
    if (csDesigning in ComponentState) and Assigned(Owner) then
    begin
      if FPreview then AssignBrush
      else RestoreBrush;
      TForm(Owner).Invalidate;
    end;
  end;
end;

procedure TBitmapFormSkin.AssignBrush;
begin
  with TForm(Owner) do
  begin
    FDesignBrush.Assign(Brush);
    Brush.Bitmap:=TBitmap.Create;
    Brush.Bitmap.Assign(FSkin);
    Brush.Bitmap.Width:=ClientWidth;
    Brush.Bitmap.Height:=ClientHeight;
  end;
end;

procedure TBitmapFormSkin.RestoreBrush;
begin
  with TForm(Owner) do
  begin
    Brush.Bitmap.Free;
    Brush.Assign(FDesignBrush);
  end;
end;

procedure TBitmapFormSkin.SkinChange(Sender: TObject);
begin
  Update;
end;

function TBitmapFormSkin.GetSkinWidth: Integer;
begin
  if FSkin.Empty then Result:=TForm(Owner).ClientWidth
  else Result:=FSkin.Width;
end;

function TBitmapFormSkin.GetSkinHeight: Integer;
begin
  if FSkin.Empty then Result:=TForm(Owner).ClientHeight
  else Result:=FSkin.Height;
end;

function TBitmapFormSkin.IsTransparent(X,Y: Integer): Boolean;
begin
  Result:=FSkin.Canvas.Pixels[X,Y]=FTransparentColor;
end;

constructor TBitmapFormSkin.Create(AOwner: TComponent);
begin
  inherited;
  FSkin:=TBitmap.Create;
  FSkin.OnChange:=SkinChange;
  FDesignBrush:=TBrush.Create;
  Update;
end;

destructor TBitmapFormSkin.Destroy;
begin
  FSkin.Free;
  if FRegion<>0 then DeleteObject(FRegion);
  FRegion:=0;
  FDesignBrush.Free;
  inherited;
end;

procedure TBitmapFormSkin.Update;
begin
  inherited;
  if (FPreview and (csDesigning in ComponentState)) or
    (not (csDesigning in ComponentState)) and (soSkin in FOptions) and Assigned(FSkin) then
  begin
    RestoreBrush;
    AssignBrush;
    TForm(Owner).Invalidate;
  end;
end;

procedure Register;
begin
  RegisterComponents('Greatis', [TSimpleFormSkin, TBitmapFormSkin]);
end;

end.