home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SAMPLES.DAT / SAMPLES / LISTBOX / LISTU1.PAS < prev   
Pascal/Delphi Source File  |  1997-07-06  |  2KB  |  78 lines
  1. Unit ListU1;
  2.  
  3. Interface
  4.  
  5. Uses
  6.   Classes, Forms, Graphics, StdCtrls;
  7.  
  8. Type
  9.   TOwnerDrawListBoxForm = Class (TForm)
  10.     ListBox1: TListBox;
  11.     Label1: TLabel;
  12.     Label2: TLabel;
  13.     Procedure ListBox1OnSetupShow (Sender: TObject);
  14.     Procedure ListBox1OnItemFocus (Sender: TObject; Index: LongInt);
  15.     Procedure ListBox1OnDrawItem (Sender: TObject; Index: LongInt; Rec: TRect;
  16.                                   State: TOwnerDrawState);
  17.   Private
  18.     {Insert private declarations here}
  19.   Public
  20.     {Insert public declarations here}
  21.   End;
  22.  
  23. Var
  24.   OwnerDrawListBoxForm: TOwnerDrawListBoxForm;
  25.  
  26. Implementation
  27.  
  28. Procedure TOwnerDrawListBoxForm.ListBox1OnSetupShow (Sender: TObject);
  29. Var t:LongInt;
  30. Begin
  31.     For t:=0 To Screen.FontCount-1 Do
  32.    ListBox1.Items.Add(Screen.Fonts[t].FaceName);
  33. End;
  34.  
  35. Procedure TOwnerDrawListBoxForm.ListBox1OnItemFocus (Sender: TObject; Index: LongInt);
  36. Begin
  37.   Label1.Text:='Selected:'+Screen.Fonts[Index].FaceName;
  38. End;
  39.  
  40. Procedure TOwnerDrawListBoxForm.ListBox1OnDrawItem (Sender: TObject; Index: LongInt;
  41.                                      Rec: TRect; State: TOwnerDrawState);
  42. Var OldFont:TFont;
  43.     rc:TRect;
  44.     CX,CY:LongInt;
  45.     TheFont:TFont;
  46. Begin
  47.    //set the desired font
  48.    OldFont:=ListBox1.Canvas.Font;
  49.    TheFont:=Screen.Fonts[Index];
  50.    ListBox1.Canvas.Font:=TheFont;
  51.  
  52.    //Set the clipping region
  53.    ListBox1.Canvas.ClipRect:=Rec;
  54.  
  55.    //put out the text and remove the text rectangle from the clipping region
  56.    ListBox1.Canvas.GetTextExtent(TheFont.FaceName,CX,CY);
  57.    rc.Left:=rec.Left;
  58.    rc.Right:=rc.Left+CX-1;
  59.    rc.Bottom:=rec.Bottom;
  60.    rc.Top:=rc.Bottom+CY-1;
  61.    If State*[odSelected]<>[] Then ListBox1.Canvas.Brush.Color:=clHighlight
  62.    Else ListBox1.Canvas.Brush.Color:=ListBox1.Color;
  63.    ListBox1.Canvas.TextOut(rc.Left,rc.Bottom,TheFont.FaceName);
  64.    ListBox1.Canvas.ExcludeClipRect(rc);
  65.  
  66.    //fill the rest portion of the entries rectangle
  67.    If State*[odSelected]<>[] Then ListBox1.Canvas.FillRect(rec,clHighlight)
  68.    Else ListBox1.Canvas.FillRect(rec,ListBox1.Color);
  69.  
  70.    //Delete the clipping region and restore the old font
  71.    ListBox1.Canvas.DeleteClipRegion;
  72.    ListBox1.Canvas.Font:=OldFont;
  73. End;
  74.  
  75. Initialization
  76.   RegisterClasses ([TOwnerDrawListBoxForm, TListBox, TLabel]);
  77. End.
  78.