home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / ADDON / BMPLIST.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-02  |  4KB  |  146 lines
  1. UNIT BmpList;
  2.  
  3.  
  4. INTERFACE
  5.  
  6. USES SysUtils,Messages,Classes,Forms,Graphics,StdCtrls;
  7.  
  8.  
  9. TYPE
  10.     TBitmapListBox=CLASS(TListBox)
  11.       PRIVATE
  12.          FBitmapList:TBitmapList;
  13.          FScaleBitmap:Boolean;
  14.       PROTECTED
  15.          PROCEDURE SetupComponent;OVERRIDE;
  16.          PROCEDURE DrawItem(Index:LONGINT;Rec:TRect;State:TOwnerDrawState);OVERRIDE;
  17.          PROCEDURE SetBitmap(Index:LONGINT;NewBitmap:TBitmap);
  18.       PUBLIC
  19.          DESTRUCTOR Destroy;OVERRIDE;
  20.          FUNCTION  AddBitmap(CONST S:STRING;ABitmap:TBitmap):LONGINT;
  21.          PROCEDURE InsertBitmap(Index:LONGINT;CONST S:STRING;ABitmap:TBitmap);
  22.          PROCEDURE Clear;OVERRIDE;
  23.          PROPERTY Bitmaps[Index:LONGINT]:TBitmap write SetBitmap;
  24.       PUBLISHED
  25.          PROPERTY ScaleBitmap:BOOLEAN read FScaleBitmap write FScaleBitmap;
  26.     END;
  27.  
  28. FUNCTION InsertBitmapListBox(Parent:TControl;X,Y,W,H,ItemHeight:LONGINT):TBitmapListBox;
  29.  
  30. IMPLEMENTATION
  31.  
  32. FUNCTION InsertBitmapListBox(Parent:TControl;X,Y,W,H,ItemHeight:LONGINT):TBitmapListBox;
  33. BEGIN
  34.      Result.Create(Parent);
  35.      Result.SetWindowPos(X,Y,W,H);
  36.      Result.TabStop := TRUE;
  37.      Result.ItemHeight := ItemHeight;
  38.      Result.Parent := Parent;
  39. END;
  40.  
  41. { TBitmapListBox }
  42.  
  43. PROCEDURE TBitmapListBox.SetupComponent;
  44. BEGIN
  45.      Inherited SetupComponent;
  46.      FBitmapList.Create;
  47.      FBitmapList.Duplicates := TRUE;
  48.      Style:=lbOwnerdrawFixed;
  49. END;
  50.  
  51.  
  52. PROCEDURE TBitmapListBox.DrawItem(Index:LONGINT;Rec:TRect;State:TOwnerDrawState);
  53. VAR  x,y,y1,cx,cy,cx1,cy1:LONGINT;
  54.      idx:LONGINT;
  55.      Bitmap:TBitmap;
  56.      s:STRING;
  57. BEGIN
  58.      IF State * [odSelected] <> [] THEN
  59.      BEGIN
  60.           Canvas.Pen.Color := clHighLightText;
  61.           Canvas.Brush.Color := clHighLight;
  62.      END ELSE
  63.      BEGIN
  64.           Canvas.Pen.Color := PenColor;
  65.           Canvas.Brush.Color := Color;
  66.      END;
  67.      Canvas.FillRect(Rec,Canvas.Brush.Color);
  68.  
  69.      x := Rec.Left + 2;
  70.      y := Rec.Bottom + 1;
  71.      cx := Rec.Right - x;
  72.      cy := Rec.Top - y;
  73.  
  74.      idx := LONGINT(Items.Objects[Index]);
  75.      IF idx >= 0 THEN Bitmap := FBitmapList.Bitmaps[idx]
  76.      ELSE Bitmap := NIL;
  77.  
  78.      IF Bitmap <> NIL THEN
  79.      BEGIN
  80.           cx1 := Bitmap.Width;
  81.           cy1 := Bitmap.Height;
  82.           y1 := y + ((cy - cy1) DIV 2);
  83.           IF y1 <= Rec.Bottom THEN y1 := Rec.Bottom + 1;
  84.  
  85.           IF ScaleBitmap THEN
  86.           BEGIN
  87.                IF y1+cy1>Rec.Top THEN cy1:=Rec.Top-y1-1;
  88.                IF Bitmap.Width=Bitmap.Height THEN cx1:=cy1;
  89.           END;
  90.  
  91.           Canvas.StretchDraw(x,y1,cx1,cy1,Bitmap);
  92.           inc(x,Bitmap.Width + 5);
  93.      END;
  94.  
  95.      s := Items.Strings[Index];
  96.      Canvas.GetTextExtent(s,cx1,cy1);
  97.      y1 := y + ((cy - cy1) DIV 2);
  98.      IF y1 < Rec.Bottom THEN y1 := Rec.Bottom;
  99.      Canvas.Brush.Mode := bmTransparent;
  100.      Canvas.TextOut(x,y1,s);
  101. END;
  102.  
  103.  
  104. DESTRUCTOR TBitmapListBox.Destroy;
  105. BEGIN
  106.      FBitmapList.Destroy;
  107.      Inherited Destroy;
  108. END;
  109.  
  110.  
  111. PROCEDURE TBitmapListBox.SetBitmap(Index:LONGINT;NewBitmap:TBitmap);
  112. BEGIN
  113.      FBitmapList.Bitmaps[Index]:=NewBitmap;
  114. END;
  115.  
  116. FUNCTION TBitmapListBox.AddBitmap(CONST S:STRING;ABitmap:TBitmap):LONGINT;
  117. VAR  idx:LONGINT;
  118. BEGIN
  119.      IF ABitmap IS TBitmap THEN idx := FBitmapList.Add(ABitmap)
  120.      ELSE idx := -1;
  121.  
  122.      Result := Items.AddObject(S,TObject(idx));
  123. END;
  124.  
  125.  
  126. PROCEDURE TBitmapListBox.InsertBitmap(Index:LONGINT;CONST S:STRING;ABitmap:TBitmap);
  127. VAR  idx:LONGINT;
  128. BEGIN
  129.      IF ABitmap IS TBitmap THEN idx := FBitmapList.Add(ABitmap)
  130.      ELSE idx := -1;
  131.  
  132.      Items.InsertObject(Index,S,TObject(idx));
  133. END;
  134.  
  135.  
  136. PROCEDURE TBitmapListBox.Clear;
  137. BEGIN
  138.      Inherited.Clear;
  139.  
  140.      FBitmapList.Clear;
  141. END;
  142.  
  143. BEGIN
  144.      RegisterClasses([TBitmapListBox]);
  145. END.
  146.