这段程序有问题吗

Question

bitmap创建了两次，为释放资源
应该
bitmap:=tbitmap.create;
try
 ...
finaly
bitmap.free;
end;

Answer 1

(*//
这段程序调试没有问题呀,我想看看全部的代码
//*)//pasunit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Tabs;type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    TabSet1: TTabSet;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure TabSet1DrawTab(Sender: TObject; TabCanvas: TCanvas; R: TRect;
      Index: Integer; Selected: Boolean);
    procedure TabSet1MeasureTab(Sender: TObject; Index: Integer;
      var TabWidth: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}procedure TForm1.FormCreate(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  ListBox1.Items := Screen.Fonts;
  Bitmap := TBitmap.Create;
  Bitmap.LoadFromFile('FIRST.BMP');
  TabSet1.Tabs.AddObject('FIRST', Bitmap);
  Bitmap := TBitmap.Create;
  Bitmap.LoadFromFile('LAST.BMP');
  TabSet1.Tabs.AddObject('LAST', Bitmap);
end;procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
begin
  with ListBox1.Canvas do
  begin
    Font.Name := ListBox1.Items[index];
    Height := TextHeight('a');
  end;
end;procedure TForm1.TabSet1MeasureTab(Sender: TObject; Index: Integer;
  var TabWidth: Integer);
var
  BitmapWidth: Integer;
begin
  BitmapWidth := TBitmap(TabSet1.Tabs.Objects[Index]).Width; //这句有问题,去掉它程序正常
  Inc(TabWidth, 2 + BitmapWidth);
end;procedure TForm1.TabSet1DrawTab(Sender: TObject; TabCanvas: TCanvas;
  R: TRect; Index: Integer; Selected: Boolean);
var
  Bitmap: TBitMap;
begin
  Bitmap := TBitMap(TabSet1.Tabs.Objects[Index]);
  with TabSet1.Canvas do
  begin
    Draw(R.Left, R.Top + 4, Bitmap);
    TextOut(R.Left + 2 + Bitmap.Width, R.Top + 2, TabSet1.Tabs[index]);
  end;
end;procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  with ListBox1.Canvas do
  begin
    FillRect(Rect);
    Font.Name := ListBox1.Items[index];
    TextOut(Rect.Left, Rect.Top, ListBox1.Items[index]);
  end;
end;end.//dfm
object Form1: TForm1
  Left = 135
  Top = 77
  Width = 544
  Height = 375
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 0
    Top = 65
    Width = 536
    Height = 283
    Align = alClient
    ItemHeight = 16
    Style = lbOwnerDrawVariable
    TabOrder = 0
    OnDrawItem = ListBox1DrawItem
    OnMeasureItem = ListBox1MeasureItem
  end
  object TabSet1: TTabSet
    Left = 0
    Top = 0
    Width = 536
    Height = 65
    Align = alTop
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    Style = tsOwnerDraw
    OnDrawTab = TabSet1DrawTab
    OnMeasureTab = TabSet1MeasureTab
  end
end

Answer 2

你改成这样试试
procedure TForm1.FormCreate(Sender: TObject);
var Bitmap:TBitMap;
begin
ListBox1.Items:=Screen.Fonts;
Bitmap:=TBitMap.Create ;
Bitmap.LoadFromFile('FIRST.BMP');
TabSet1.Tabs.AddObject('first',pointer(Bitmap));
Bitmap:=TBitMap.Create ;
Bitmap.LoadFromFile('LAST.BMP');
TabSet1.Tabs.AddObject('last',pointer(Bitmap));end;

Answer 3

of couse it just have two problems.