Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.08.28;
Скачать: CL | DM;

Вниз

Можно ли убрать поля в PageControl   Найти похожие ветки 

 
chis   (2004-08-31 17:41) [0]

При размещении во вкладках компонента с алигном типа клиент остаются поля. Заказчику это почему-то очень не нравится, а как их срубить я не знаю. Помогите плз.


 
Awex   (2004-08-31 21:16) [1]

{******************************************}
{  Sphere Component Library                }
{ (c) 2003, 2004 by Sphere Software Group  }
{******************************************}

unit sphPageControl;

interface

uses
 Windows, Messages, Classes, CommCtrl, ComCtrls;

type
 TExStyle = (exsStandard, exsFlat, exsUltraFlat);

 TxPageControl = class(TPageControl)
 protected
   FExStyle: TExStyle;
   procedure SetExStyle(Value: TExStyle);
   procedure WndProc(var Message: TMessage); override;
 public
   constructor Create(Owner: TComponent); override;
 published
   property ExStyle: TExStyle read FExStyle write SetExStyle default exsStandard;
 end;

 TxTabControl = class(TTabControl)
 protected
   FExStyle: TExStyle;
   procedure SetExStyle(Value: TExStyle);
   procedure WndProc(var Message: TMessage); override;
 public
   constructor Create(Owner: TComponent); override;
 published
   property ExStyle: TExStyle read FExStyle write SetExStyle default exsStandard;
 end;

implementation

constructor TxPageControl.Create(Owner: TComponent);
begin
 inherited Create(Owner);
 ExStyle := exsStandard;
 HotTrack := true;
end;

procedure TxPageControl.SetExStyle(Value: TExStyle);
begin
 if FExStyle <> Value then
 begin
   FExStyle := Value;
   Realign;
 end;
end;

procedure TxPageControl.WndProc(var Message: TMessage);
begin
 inherited WndProc(Message);
 if (FExStyle <> exsStandard) and (Message.Msg = TCM_ADJUSTRECT) then
 begin
   if FExStyle = exsFlat then
   begin
     if TabPosition = tpTop then
     begin
       PRect(Message.LParam)^.Left := 2;
       PRect(Message.LParam)^.Right := ClientWidth - 2;
       PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 2;
       PRect(Message.LParam)^.Bottom := ClientHeight - 2;
     end
     else
       if TabPosition = tpBottom then
       begin
         PRect(Message.LParam)^.Left := 0;
         PRect(Message.LParam)^.Right := ClientWidth;
         PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 4;
         PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 2;
       end;
   end
   else
   begin
     if TabPosition = tpTop then
     begin
       PRect(Message.LParam)^.Left := 0;
       PRect(Message.LParam)^.Right := ClientWidth;
       PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 4;
       PRect(Message.LParam)^.Bottom := ClientHeight;
     end
     else
       if TabPosition = tpBottom then
       begin
         PRect(Message.LParam)^.Left := 0;
         PRect(Message.LParam)^.Right := ClientWidth;
         PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 4;
         PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 2;
       end;
   end;
 end;
end;

{ TxTabControl }

constructor TxTabControl.Create(Owner: TComponent);
begin
 inherited Create(Owner);
 ExStyle := exsStandard;
 HotTrack := true;
end;

procedure TxTabControl.SetExStyle(Value: TExStyle);
begin
 if FExStyle <> Value then
 begin
   FExStyle := Value;
   Realign;
 end;
end;

procedure TxTabControl.WndProc(var Message: TMessage);
begin
 inherited WndProc(Message);
 if (FExStyle <> exsStandard) and (Message.Msg = TCM_ADJUSTRECT) then
 begin
   if FExStyle = exsFlat then
   begin
     if TabPosition = tpTop then
     begin
       PRect(Message.LParam)^.Left := 2;
       PRect(Message.LParam)^.Right := ClientWidth - 2;
       PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 2;
       PRect(Message.LParam)^.Bottom := ClientHeight - 2;
     end
     else
       if TabPosition = tpBottom then
       begin
         PRect(Message.LParam)^.Left := 0;
         PRect(Message.LParam)^.Right := ClientWidth;
         PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 4;
         PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 2;
       end;
   end
   else
   begin
     if TabPosition = tpTop then
     begin
       PRect(Message.LParam)^.Left := 0;
       PRect(Message.LParam)^.Right := ClientWidth;
       PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 4;
       PRect(Message.LParam)^.Bottom := ClientHeight;
     end
     else
       if TabPosition = tpBottom then
       begin
         PRect(Message.LParam)^.Left := 0;
         PRect(Message.LParam)^.Right := ClientWidth;
         PRect(Message.LParam)^.Top := PRect(Message.LParam)^.Top - 4;
         PRect(Message.LParam)^.Bottom := PRect(Message.LParam)^.Bottom + 2;
       end;
   end;
 end;
end;

end.



Страницы: 1 вся ветка

Текущий архив: 2005.08.28;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.04 c
14-1123079472
Ega23
2005-08-03 18:31
2005.08.28
Quantum Grid от Developer Express для Delphi 7


14-1123143302
kblc
2005-08-04 12:15
2005.08.28
Debug


10-1100616891
MegaLexx
2004-11-16 17:54
2005.08.28
Нетривиальный (то бишь неправильный) импорт ActiveX компонента


3-1121338260
Леонид
2005-07-14 14:51
2005.08.28
Узнать и передать значение если запись с пометкой на удаление...


1-1123426043
Demidoff
2005-08-07 18:47
2005.08.28
Из книжной в альбомную в richedit