Delphi-PRAXiS
Seite 2 von 2     12   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi Checkbox in TabSheet (https://www.delphipraxis.net/141457-checkbox-tabsheet.html)

Bambuti2000 20. Okt 2009 15:53

Re: Checkbox in TabSheet
 
Liste der Anhänge anzeigen (Anzahl: 1)
OK,
ich hab die Lösung, nachdem ich mich an diesem Thread (freundlicherweise von hathor gepostet) orientiert habe.

Hier die Lösung (Sind nur die Schnipsel die auch benötigt werden):

Delphi-Quellcode:
uses Themes, CommCtrl;

const
  UM_DESTROYCONTROL = WM_USER + 1;

type
  TForm1 = class(TForm)
  private
    procedure ShowTabCheckBoxes;
    procedure ShowTabCheckBox(PageIndex: Integer);
    function CheckBoxChecked(TabSheetIndex: Integer; var CheckBoxStatus: Integer): Boolean;
    procedure ReCalculateCheckBoxPositions;
    procedure UmDestroyControl(var msg: TMessage); message UM_DESTROYCONTROL;
    procedure CheckBoxDestroy(Sender: TObject);
  public
    { Public-Deklarationen }
  end;

  TrwCheckBox = class(TCheckBox)
  private
    { Private-Deklarationen }
  public
    constructor Create(AOwner: TComponent); override;
  end;

constructor TrwCheckBox.Create(AOwner: TComponent);
begin
  inherited;
  Height := 14;
  Width := 14;
//  Checked := True;
//  AllowGrayed := DoAllowGrayed;
end;

procedure TForm1.ReCalculateCheckBoxPositions;
var
  i: Byte;
  Rect: TRect;
begin
  if PageControl1.PageCount <> 0 then
  begin
    for i := 0 to Pred(PageControl1.PageCount) do
    begin
      Rect := PageControl1.TabRect(i);
      with TrwCheckBox(PageControl1.Pages[i].Tag) do
      begin
        Top := Rect.Top + 3;
        Left := Rect.Left + 4;
      end;
    end;
    RedrawWindow(PageControl1.Handle, nil, 0,
      RDW_ERASE or RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN);
  end;
end;

procedure TForm1.ShowTabCheckBox(PageIndex: Integer);
var
  sCheckBox: TrwCheckBox;
  Rect: TRect;
begin
  sCheckBox := TrwCheckBox.Create(PageControl1.Pages[PageIndex]);
  sCheckBox.Parent := PageControl1;
  sCheckBox.OnMouseUp := CheckBoxOnMouseUp;
  PageControl1.Pages[PageIndex].Tag := Integer(sCheckBox);
  //Notlösung, da kA wie man das TRect manuell setzt um den Reiter zu verbreitern:
  PageControl1.Pages[PageIndex].Caption := '    ' + PageControl1.Pages[PageIndex].Caption;
  Rect := PageControl1.TabRect(PageIndex);
  sCheckBox.Top := Rect.Top + 3;
  sCheckBox.Left := Rect.Left + 4;
end;

procedure TForm1.ShowTabCheckBoxes;
var
  i: Byte;
begin
  for i := 0 to Pred(PageControl1.PageCount) do
    ShowTabCheckBox(i);
end;

{*** Diese Funktion ist nur für meine Zwecke nötig ***}
function TForm1.CheckBoxChecked(TabSheetIndex: Integer; var CheckBoxStatus: Integer): Boolean;
begin
  case TrwCheckBox(PageControl1.Pages[TabSheetIndex].Tag).State of
    cbUnchecked : CheckBoxStatus := 0;
    cbGrayed   : CheckBoxStatus := 1;
    cbChecked  : CheckBoxStatus := 2;
  end;
  result := CheckBoxStatus > 0;
end;
{*** Diese Funktion ist nur für meine Zwecke nötig ***}

{*** nur zum löschen eines Tabs wärend der Laufzeit notwendig ***}
procedure TForm1.UmDestroyControl(var msg: TMessage);
begin
  TComponent(msg.LParam).Owner.Free;
  ReCalculateCheckBoxPositions;
end;

procedure TForm1.CheckBoxDestroy(Sender: TObject);
begin
  if PtInRect((Sender as TrwCheckBox).ClientRect, Point(X, Y)) then
    PostMessage(Handle, UM_DESTROYCONTROL, 0, Integer(Sender));
end;
{*** nur zum löschen eines Tabs wärend der Laufzeit notwendig ***}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ShowTabCheckBoxes;
end;
Im Anhang hab ich dann noch ein Bild davon, wie's bei mir aussieht...

Vielen Dank für eure Hilfe und ich hoffe daß es den ein oder anderen gibt, der evtl. auch Interresse an dieser Lösung hat.

Gruß
Stefan

Bernhard Geyer 20. Okt 2009 15:57

Re: Checkbox in TabSheet
 
Liste der Anhänge anzeigen (Anzahl: 1)
Geht mit ElPack-pagecontrol und zugewiesener Imagelist


Alle Zeitangaben in WEZ +1. Es ist jetzt 07:03 Uhr.
Seite 2 von 2     12   

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz