• Latest

    Sunday, December 18, 2016

    Delphi tutorial - Tabbed interface

    Delphi example showing how to create tabbed interface.

    Here you can see how to dynamically create Memo and Picture and put them in Active sheet ( active tab ).

    Also some actions with tabs, add, edit caption, move, delete ...

    In following video you can see whole process of creating this example :


    Following is full source code and also picture and icon used in the example:




    (code style formatted by http://hilite.me/ )



    unit MainForm;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ComCtrls, ImgList, ExtCtrls, jpeg;
    
    type
      TfrmMain = class(TForm)
        Panel1: TPanel;
        Panel2: TPanel;
        Button1: TButton;
        Button2: TButton;
        Button3: TButton;
        Button4: TButton;
        Edit1: TEdit;
        Button5: TButton;
        PageControl1: TPageControl;
        ImageList1: TImageList;
        procedure Button2Click(Sender: TObject);
        procedure Button1Click(Sender: TObject);
        procedure Button5Click(Sender: TObject);
        procedure Button3Click(Sender: TObject);
        procedure Button4Click(Sender: TObject);
        procedure PageControl1Change(Sender: TObject);
        procedure PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer);
        procedure PageControl1DragOver(Sender, Source: TObject; X, Y: Integer;
          State: TDragState; var Accept: Boolean);
        procedure PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      frmMain: TfrmMain;
      TbPg:TTabSheet;
    
    implementation
    
    {$R *.dfm}
    
    procedure TfrmMain.Button1Click(Sender: TObject);
    begin
    if PageControl1.PageCount=0  then Exit;
    PageControl1.ActivePage.Free;
    end;
    
    procedure TfrmMain.Button2Click(Sender: TObject);
    begin
    TbPg:=TTabSheet.Create(PageControl1);
    TbPg.PageControl:=PageControl1;
    TbPg.ImageIndex:=0;
    TbPg.Caption:='Tab '+IntToStr(PageControl1.PageCount);
    PageControl1.ActivePage:=TbPg;
    PageControl1.TabWidth:=150;
    end;
    
    procedure TfrmMain.Button3Click(Sender: TObject);
    var
    memx:TMemo;
    begin
    if PageControl1.PageCount=0  then Exit;
    memx:=TMemo.Create(PageControl1.ActivePage);
    memx.Parent:=PageControl1.ActivePage;
    memx.Align:=alClient;
    memx.Lines.Add('Created in '+PageControl1.ActivePage.Caption);
    end;
    
    procedure TfrmMain.Button4Click(Sender: TObject);
    var
    imgx:TImage;
    begin
    if PageControl1.PageCount=0  then Exit;
    imgx:=TImage.Create(PageControl1.ActivePage);
    imgx.Parent:=PageControl1.ActivePage;
    imgx.Align:=alClient;
    imgx.Proportional:=True;
    imgx.Picture.LoadFromFile('flower.jpg');// picture prepared earlier in app folder
    end;
    
    procedure TfrmMain.Button5Click(Sender: TObject);
    begin
    if PageControl1.PageCount=0  then Exit;
    PageControl1.ActivePage.Caption:=Edit1.Text;
    end;
    
    procedure TfrmMain.PageControl1Change(Sender: TObject);
    begin
    frmMain.Caption:=PageControl1.ActivePage.Caption;
    end;
    
    procedure TfrmMain.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer);
    const
    TCM_GETITEMRECT = $130A  ;
    var
    i:Integer;
    r:TRect;
    begin
    //let's try to drag / move tabs
    if not ( Sender is TPageControl ) then Exit;
    
     with PageControl1 do begin
       for i := 0 to PageCount-1 do begin
    
         Perform(TCM_GETITEMRECT,i,lParam(@r)) ;
         if PtInRect(r,Point(X,Y)) then begin
         if i<> ActivePage.PageIndex then ActivePage.PageIndex:=i;
         OnChange(Self);
         Exit;
         end;
       end;
     end;
    
    end;
    
    procedure TfrmMain.PageControl1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    begin
    if Sender is TPageControl then  Accept:=True;
    
    end;
    
    procedure TfrmMain.PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    begin
    PageControl1.BeginDrag(False);
    end;
    
    end.
    

    Fashion

    Beauty

    Travel