这是控件的代码
我装在D6上只要想窗体放控件提示"access violation at address 039cbff5 .write of address ae400b43" 地址点以下变换另一个地址. 帮忙解决一下
unit ExtListView;
interface
uses
// 太多无用的,不想繁啦,都加上吧!
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls, CommCtrl;
type
TExtListView = class(TCustomListView)
private
FBitMap: TPicture;
FInterDrawing: boolean;
FFlag: Boolean;
FHOffer:Integer;
procedure PaintBei;
procedure SetBitMap(Value: TPicture);
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMEraseBkgnd(var Message:TMessage);message WM_ERASEBKGND;
procedure WMNotify(var Message: TMessage);message WM_NOTIFY;
procedure WMHscroll(var Message:TMessage);message WM_HSCROLL;
protected
// 消息响应,可根据自己的情况进行增加!
// 增加的越多,系统资源占用越多!
// 增加数据时,最好使用BeginUpdate.......EndUpdate
procedure WndProc(var Message: TMessage); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
// property Background: TPicture read FBitmap write SetBitMap;
// property IsGrid:Boolean read FIsGrid write SetIsGridLine;
property Action;
property Align;
property AllocBy;
property Anchors;
property Background: TPicture read FBitmap write SetBitMap;
property BevelEdges;
property BevelInner;
property BevelOuter;
property BevelKind default bkNone;
property BevelWidth;
property BiDiMode;
property BorderStyle;
property BorderWidth;
property Checkboxes;
property Color;
property Columns;
property ColumnClick;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property FlatScrollBars;
property FullDrag;
property GridLines;
property HideSelection;
property HotTrack;
property HotTrackStyles;
property HoverTime;
property IconOptions;
property Items;
property LargeImages;
property MultiSelect;
property OwnerData;
property OwnerDraw;
property ReadOnly default False;
property RowSelect;
property ParentBiDiMode;
property ParentColor default False;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowColumnHeaders;
property ShowWorkAreas;
property ShowHint;
property SmallImages;
property SortType;
property StateImages;
property TabOrder;
property TabStop default True;
property ViewStyle;
property Visible;
property OnAdvancedCustomDraw;
property OnAdvancedCustomDrawItem;
property OnAdvancedCustomDrawSubItem;
property OnChange;
property OnChanging;
property OnClick;
property OnColumnClick;
property OnColumnDragged;
property OnColumnRightClick;
property OnCompare;
property OnContextPopup;
property OnCustomDraw;
property OnCustomDrawItem;
property OnCustomDrawSubItem;
property OnData;
property OnDataFind;
property OnDataHint;
property OnDataStateChange;
property OnDblClick;
property OnDeletion;
property OnDrawItem;
property OnEdited;
property OnEditing;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetImageIndex;
property OnGetSubItemImage;
property OnDragDrop;
property OnDragOver;
property OnInfoTip;
property OnInsert;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnSelectItem;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TExtListView]);
end;
constructor TExtListView.Create(AOwner: TComponent);
begin
inherited;
FBitmap:=TPicture.Create;
FHOffer:=0;
FFlag:=False;
end;
destructor TExtListView.Destroy;
begin
FBitmap.Free;
inherited;
end;
procedure TExtListView.PaintBei;
var
ps: PAINTSTRUCT;
Rect:TRect;
DC, drawDC1, drawDC2: HDC;
drawBMP1, drawBMP2, oldBMP1, oldBMP2: HBitmap;
iWidth, iHeight, ibmpWidth, ibmpHeight, I, J, K, W: integer;
ACanvas:TCanvas;
begin
// 避免
if Assigned(BackGround) then begin
FInterDrawing := True;
// 加个try!
try
BeginPaint(Handle, Ps);
// 再加一个try,嘿嘿!
try
DC := Ps.hdc;
iWidth := ClientWidth;
iHeight := ClientHeight;
drawDC1 := CreateCompatibleDC(DC);
drawBMP1 := CreateCompatibleBitmap(DC, iWidth, iHeight);
oldBMP1 := SelectObject(drawDC1, drawBMP1);
ACanvas:=TCanvas.Create;
ACanvas.Handle:=drawDC1;
ACanvas.Brush.Color:=clWindow;
Rect.Left:=0;
Rect.Top:=0;
Rect.Right:=iWidth;
Rect.Bottom:=iHeight;
ACanvas.FillRect(Rect);
SendMessage(Handle, WM_PAINT, drawDC1, 0);
drawDC2 := CreateCompatibleDC(DC);
drawBMP2 := CreateCompatibleBitmap(DC, iWidth, iHeight);
oldBMP2 := SelectObject(drawDC2, drawBMP2);
iBmpWidth := Background.Width;
iBmpHeight := Background.Height;
if (iBmpWidth<>0) and (iBmpHeight<>0) then begin
K := ClientWidth div iBmpWidth;
W := ClientHeight div iBmpHeight;
for I := 0 to K do
for J := 0 to W do
BitBlt(drawDC2, I * iBmpWidth, J * iBmpHeight, iBmpWidth, iBmpHeight, FBitmap.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
end else
begin
ACanvas.Handle:=drawDC2;
ACanvas.FillRect(Rect);
end;
if Items.Count>0 then
TransparentBlt(drawDC2, 0, 0, iWidth, iHeight, drawDC1, 0, 0, iWidth, iHeight, ColorToRGB(clWindow));
// if GetClipBox(DC,Rect)= NULLREGION then
BitBlt(DC, 0, 0, CLientWidth, ClientHeight, drawDC2, 0, 0, SRCCOPY);
// else
// BitBlt(DC, Rect.Left, Rect.Top, Rect.Right-Rect.Left, Rect.Bottom-Rect.Top, drawDC2, Rect.Left, Rect.Top, SRCCOPY);
SelectObject(drawDC1, oldBMP1);
DeleteObject(drawDC1);
DeleteObject(drawBMP1);
SelectObject(drawDC2, oldBMP2);
DeleteObject(drawDC2);
DeleteObject(drawBMP2);
ACanvas.Free;
finally
EndPaint(Handle, Ps);
end;
finally
FInterDrawing := False;
end;
end else
inherited;
end;
procedure TExtListView.SetBitMap(Value: TPicture);
begin
FBitMap.Assign(Value);
if HandleAllocated then Invalidate;
end;
procedure TExtListView.WMEraseBkgnd(var Message: TMessage);
begin
if not Assigned(BackGround) then inherited;
end;
procedure TExtListView.WMHscroll(var Message: TMessage);
begin
if FFlag=True then
FFlag:=False
else
inherited;
end;
procedure TExtListView.WMNotify(var Message: TMessage);
var HdNotify
HDNOTIFY;
begin
inherited;
if Assigned(BackGround) then begin
HdNotify:=PHDNOTIFY(message.LParam);
if (HdNotify^.Hdr.code=HDN_ITEMCHANGED) or (HdNotify^.Hdr.code=HDN_ITEMCHANGING) then begin
Columns.Items[HdNotify^.Item].Width:=HdNotify^.PItem^.cxy;
FFlag:=True;
end;
end;
end;
procedure TExtListView.WMPaint(var Message: TWMPaint);
begin
// 条件
if (FBitMap = nil) or FInterDrawing then
begin
inherited
end
else
PaintBei;
end;
procedure TExtListView.WndProc(var Message: TMessage);
var
pDS
DrawItemStruct;
phd
HDNotify;
begin
case Message.Msg of
// WM_ERASEBKGND:
// begin
// Message.Result := 1;
// Exit;
// end;
WM_HSCROLL,
WM_VSCROLL,
WM_MOUSEWHEEL,
WM_LBUTTONDOWN,
WM_LBUTTONDBLCLK,
WM_MBUTTONDOWN,
WM_MBUTTONDBLCLK,
WM_KEYUP:
InvalidateRect(Handle, nil, False);
end;
inherited;
end;
end.
]