Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 07 - Project HdrSlipt

Project Structure

HdrSlipt.dpr
program HdrSlipt;

uses
  Forms,
  SplitF in 'SplitF.pas' {Form1};

{$R *.RES}

begin
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
SplitF.pas
unit SplitF;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    ListBox2: TListBox;
    ListBox3: TListBox;
    FontDialog1: TFontDialog;
    HeaderControl1: THeaderControl;
    procedure ListBoxDblClick(Sender: TObject);
    procedure HeaderControl1SectionResize(HeaderControl: THeaderControl;
      Section: THeaderSection);
    procedure HeaderControl1SectionClick(HeaderControl: THeaderControl;
      Section: THeaderSection);
    procedure HeaderControl1SectionDrag(Sender: TObject; FromSection,
      ToSection: THeaderSection; var AllowDrag: Boolean);
    procedure Form1Resize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ListBoxDblClick(Sender: TObject);
begin
  with Sender as TListbox do
  begin
    FontDialog1.Font := Font;
    if FontDialog1.Execute then
      Font := FontDialog1.Font;
  end;
end;

procedure TForm1.HeaderControl1SectionResize(HeaderControl: THeaderControl;
  Section: THeaderSection);
var
  List: TListBox;
begin
  List := FindComponent ('ListBox' + IntToStr (Section.ImageIndex)) as TListBox;
  List.Width := Section.Width;
end;

procedure TForm1.HeaderControl1SectionClick(HeaderControl: THeaderControl;
  Section: THeaderSection);
var
  List: TListBox;
begin
  List := FindComponent ('ListBox' + IntToStr (Section.ImageIndex)) as TListBox;
  List.Sorted := not List.Sorted;
end;

procedure TForm1.HeaderControl1SectionDrag(Sender: TObject; FromSection,
  ToSection: THeaderSection; var AllowDrag: Boolean);
var
  List: TListBox;
begin
  List := FindComponent ('ListBox' + IntToStr (FromSection.ImageIndex)) as TListBox;
  List.Left := ToSection.Left;
  List.Width := ToSection.Width;

  List := FindComponent ('ListBox' + IntToStr (ToSection.ImageIndex)) as TListBox;
  List.Left := FromSection.Left;
  List.Width :=fromSection.Width;
end;

procedure TForm1.Form1Resize(Sender: TObject);
var
  I: Integer;
  List: TListBox;
begin
  for I := 0 to 2 do
  begin
    List := FindComponent ('ListBox' + IntToStr (
      HeaderControl1.Sections[I].ImageIndex)) as TListBox;
    List.Left := HeaderControl1.Sections[I].Left;
    List.Width := HeaderControl1.Sections[I].Width;
  end;
end;

end.
SplitF.dfm
object Form1: TForm1
  Left = 189
  Top = 96
  ActiveControl = ListBox1
  AutoScroll = False
  Caption = 'Split with a HeaderControl'
  ClientHeight = 400
  ClientWidth = 540
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnResize = Form1Resize
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 0
    Top = 20
    Width = 179
    Height = 380
    Align = alLeft
    Anchors = []
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -64
    Font.Name = 'Arial'
    Font.Style = []
    ItemHeight = 72
    Items.Strings = (
      'Whale'
      'Elephant'
      'Rhino'
      'Shark'
      'Giraffe')
    ParentFont = False
    TabOrder = 0
    OnDblClick = ListBoxDblClick
  end
  object ListBox2: TListBox
    Left = 179
    Top = 20
    Width = 179
    Height = 380
    Align = alLeft
    Anchors = []
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -32
    Font.Name = 'Arial'
    Font.Style = []
    ItemHeight = 36
    Items.Strings = (
      'Dog'
      'Cat'
      'Hen'
      'Monkey'
      'Cow'
      'Bull'
      'Hare'
      'Sheep')
    ParentFont = False
    TabOrder = 1
    OnDblClick = ListBoxDblClick
  end
  object ListBox3: TListBox
    Left = 358
    Top = 20
    Width = 182
    Height = 380
    Align = alClient
    Anchors = []
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -12
    Font.Name = 'Arial'
    Font.Style = []
    ItemHeight = 15
    Items.Strings = (
      'Lizard'
      'Ant'
      'Shrimp'
      'Bug'
      'Bee')
    ParentFont = False
    TabOrder = 2
    OnDblClick = ListBoxDblClick
  end
  object HeaderControl1: THeaderControl
    Left = 0
    Top = 0
    Width = 540
    Height = 20
    DragReorder = True
    Sections = <
      item
        AutoSize = True
        ImageIndex = 1
        MaxWidth = 400
        MinWidth = 40
        Text = 'Big list'
        Width = 180
      end
      item
        AutoSize = True
        ImageIndex = 2
        MaxWidth = 400
        MinWidth = 40
        Text = 'Medium list'
        Width = 180
      end
      item
        AutoSize = True
        ImageIndex = 3
        MaxWidth = 200
        MinWidth = 40
        Text = 'Small list'
        Width = 180
      end>
    Style = hsFlat
    OnSectionClick = HeaderControl1SectionClick
    OnSectionDrag = HeaderControl1SectionDrag
    OnSectionResize = HeaderControl1SectionResize
  end
  object FontDialog1: TFontDialog
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'System'
    Font.Style = []
    MinFontSize = 0
    MaxFontSize = 0
    Left = 488
    Top = 336
  end
end