代码如下unit USkypeGrid;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, Grids, StdCtrls, ExtCtrls;type TSkypeGridValue = packed record Email: string; bOnLine: Boolean; end; TRowProperty = packed record RowGreenButtonBeSelect: Boolean; MouseDown, MouseUp: Boolean; end; TGridValue = packed record SkypeGridValue: TSkypeGridValue; RowProperty: TRowProperty; end; TSkypePhoneButtonEvent = procedure(Sender: TObject; RowIndex: integer; Email: string) of object;type TSkypeGrid = class(TStringGrid) //(TbsSkinStringGrid) FSelectBackImage: TImage; FGridHeadImage: TImage; FGreenButtonImageS, FGreenButtonImageD: TImage; procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: integer; var CanSelect: Boolean); procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: integer; ARect: TRect; State: TGridDrawState); function GetSelectEMail: string; private FSkypePhoneButtonEvent: TSkypePhoneButtonEvent; // LastSelectRow, LastSelectRowHeights: integer; GridValue: array of TGridValue; { Private declarations } procedure InitSkypeGrid; function IsInADrawArea(x, y: integer; var ARow, Which: integer): Boolean; procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; x, y: integer); procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: integer); procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: integer); procedure CreateImage; procedure StringGrid1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: integer; MousePos: TPoint; var Handled: Boolean); public { Public declarations } constructor Create(AOwner: TComponent); destructor Destroy; override; procedure Append(Value: TSkypeGridValue); property OnSkypePhoneButtonEvent: TSkypePhoneButtonEvent read FSkypePhoneButtonEvent write FSkypePhoneButtonEvent; property SelectEMail: string read GetSelectEMail; end;implementationuses Unit1;procedure TSkypeGrid.StringGrid1SelectCell(Sender: TObject; ACol, ARow: integer; var CanSelect: Boolean);begin // if ARow <> 0 then begin if LastSelectRowHeights <> 0 then RowHeights[LastSelectRow] := LastSelectRowHeights; LastSelectRow := ARow; LastSelectRowHeights := RowHeights[ARow]; RowHeights[ARow] := FSelectBackImage.Height; // end;end;procedure TSkypeGrid.StringGrid1DrawCell(Sender: TObject; ACol, ARow: integer; ARect: TRect; State: TGridDrawState); function DestTop: integer; var i: integer; begin Result := 0; for i := 0 to ARow - 1 do begin Result := Result + RowHeights
; end; end;var SourceRect, DestRect: TRect; TempARect: TRect; i: integer;begin // // if ARow = 0 then beginform1.Memo1.Lines.Add(inttostr(Gettickcount)) ; // exit; // end; if LastSelectRow = ARow then begin // DestRect := Rect(0, DefaultRowHeight * ARow + 2 - TopRow * DefaultRowHeight, FSelectBackImage.Width, DefaultRowHeight * ARow + FSelectBackImage.Height + 2 - TopRow * DefaultRowHeight); //DestRect := Rect(0, DefaultRowHeight * ARow + 2, FSelectBackImage.Width, DefaultRowHeight * ARow + FSelectBackImage.Height + 2); // SourceRect := Rect(0, 0, FSelectBackImage.Width, FSelectBackImage.Height); // if Self.RowCount > 0 then begin Canvas.CopyRect(DestRect, FSelectBackImage.Canvas, SourceRect); // DestRect := Rect(Width - 16, DefaultRowHeight * ARow + 2 - TopRow * DefaultRowHeight, Width, DefaultRowHeight * ARow + FSelectBackImage.Height + 2 - TopRow * DefaultRowHeight); SourceRect := Rect(270, 0, FSelectBackImage.Width, FSelectBackImage.Height); Canvas.CopyRect(DestRect, FSelectBackImage.Canvas, SourceRect); for i := 1 to (Width - 240 - 16) div 10 do begin DestRect := Rect(240 + i * 10, DefaultRowHeight * ARow + 2 - TopRow * DefaultRowHeight, 240 + i * 10 + 10, DefaultRowHeight * ARow + FSelectBackImage.Height + 2 - TopRow * DefaultRowHeight); SourceRect := Rect(240, 0, 250, FSelectBackImage.Height); Canvas.CopyRect(DestRect, FSelectBackImage.Canvas, SourceRect); end; // Canvas.Brush.Color := Canvas.Pixels[6, DestRect.Top + 6]; Canvas.Font.Style := [fsBold]; if GridValue[ARow].SkypeGridValue.bOnLine then begin Canvas.TextOut(6, DestRect.Top + 6, GridValue[ARow].SkypeGridValue.Email + '(ÔÚÏß'); end else begin Canvas.TextOut(6, DestRect.Top + 6, GridValue[ARow].SkypeGridValue.Email + '(ÀëÏß'); end; // form1.Memo1.Lines.Add(inttostr(ACol) + ' ' + inttostr(ARow) + ' ' + GridValue[ARow].SkypeGridValue.Email); end; // if (gdSelected in State) and (gdFocused in State) then begin // TempARect := ARect; // TempARect.Left := TempARect.Left - 1; // TempARect.Bottom := TempARect.Bottom + 1; Canvas.DrawFocusRect(ARect); end; end else begin if ARow < LastSelectRow then begin DestRect := Rect(0, DefaultRowHeight * (ARow - TopRow) + 2, FGridHeadImage.Width, DefaultRowHeight * (ARow - TopRow) + FGridHeadImage.Height + 2); //DestRect := Rect(0, DefaultRowHeight * (ARow ) + 2, FGridHeadImage.Width, DefaultRowHeight * (ARow ) + FGridHeadImage.Height + 2); // SourceRect := Rect(0, 0, FGridHeadImage.Width, FGridHeadImage.Height); // Canvas.CopyRect(DestRect, FGridHeadImage.Canvas, SourceRect); // Canvas.TextOut(DestRect.Left + 2, DestRect.Top + 20, 'µÚ' + inttostr(ARow) + 'ÐÐ'); end else if ARow > LastSelectRow then begin // DestRect := Rect(0, DefaultRowHeight * (ARow - TopRow) + 2 , // FGridHeadImage.Width, DefaultRowHeight * (ARow - TopRow) + FGridHeadImage.Height + 2 ); //DestRect := Rect(0, DestTop + 2, FGridHeadImage.Width, DefaultRowHeight + DestTop + 2); if TopRow > LastSelectRow then begin DestRect := Rect(0, DestTop + 2 - (TopRow - 1) * DefaultRowHeight - FSelectBackImage.Height, FGridHeadImage.Width, DefaultRowHeight + DestTop + 2 - (TopRow - 1) * DefaultRowHeight - FSelectBackImage.Height); end else if TopRow < LastSelectRow then begin DestRect := Rect(0, DestTop + 2 - (TopRow) * DefaultRowHeight, FGridHeadImage.Width, DefaultRowHeight + DestTop + 2 - (TopRow) * DefaultRowHeight); end else if TopRow = LastSelectRow then begin DestRect := Rect(0, DestTop + 2 - (TopRow) * DefaultRowHeight, FGridHeadImage.Width, DefaultRowHeight + DestTop + 2 - (TopRow) * DefaultRowHeight); end; // SourceRect := Rect(0, 0, FGridHeadImage.Width, FGridHeadImage.Height); // Canvas.CopyRect(DestRect, FGridHeadImage.Canvas, SourceRect); // Canvas.TextOut(DestRect.Left + 2, DestRect.Top + 20, 'µÚ' + inttostr(ARow) + 'ÐÐ'); end; Canvas.Brush.Color := clWhite; // Canvas.Pixels[6, DestRect.Top + 6]; Canvas.Pen.Color := clBlack; Canvas.Font.Style := [fsBold]; // Canvas.FillRect(Rect(DestRect.Left + FGridHeadImage.Width, DestRect.Top, DestRect.Right, DestRect.Bottom)); Canvas.TextOut(FGridHeadImage.Width + 6, DestRect.Top + 6, GridValue[ARow].SkypeGridValue.Email); Canvas.Brush.Color := clWhite; Canvas.Pen.Color := clBlack; if GridValue[ARow].SkypeGridValue.bOnLine then begin Canvas.TextOut(FGridHeadImage.Width + 6, DestRect.Top + 20, 'ÔÚÏß'); end else begin Canvas.TextOut(FGridHeadImage.Width + 6, DestRect.Top + 20, 'ÀëÏß'); end; //form1.Memo1.Lines.Add(inttostr(ACol) + ' ' + inttostr(ARow) + ' ' + GridValue[ARow].SkypeGridValue.Email); end;end;constructor TSkypeGrid.Create(AOwner: TComponent);var aa: Boolean;begin inherited Create(AOwner); LastSelectRow := 0; CreateImage; InitSkypeGrid; Self.OnSelectCell := Self.StringGrid1SelectCell; Self.OnDrawCell := Self.StringGrid1DrawCell; Self.OnMouseMove := Self.StringGrid1MouseMove; Self.OnMouseDown := Self.StringGrid1MouseDown; Self.OnMouseUp := Self.StringGrid1MouseUp; Self.OnMouseWheel := Self.StringGrid1MouseWheel; // // Self.Hide // StringGrid1SelectCell(Self, 0, 0, aa);end;destructor TSkypeGrid.Destroy;begin // inherited;end;procedure TSkypeGrid.InitSkypeGrid;begin ColCount := 1; DefaultColWidth := 768; DefaultRowHeight := FGridHeadImage.Height; FixedCols := 0; FixedRows := 0; Options := [goRowSizing]; // ScrollBars := ssVertical; // RowCount := 1; // RowHeights[0] := 0; Self.Height := 400; //Self.def setlength(GridValue, RowCount);end;procedure TSkypeGrid.Append(Value: TSkypeGridValue);var i: integer; Have: Boolean;begin Have := false; for i := 0 to Length(GridValue) - 1 do begin if GridValue.SkypeGridValue.Email = Value.Email then begin GridValue.SkypeGridValue := Value; Have := true; end else if GridValue.SkypeGridValue.Email = '' then begin GridValue.SkypeGridValue := Value; Have := true; end; end; if not Have then begin setlength(GridValue, Length(GridValue) + 1); GridValue[Length(GridValue) - 1].SkypeGridValue := Value; end; RowCount := Length(GridValue); Self.Row := Self.RowCount - 1; //TStringGrid(Self).MoveCurrentEX(0, 0, true, true); Self.Refresh;end;procedure TSkypeGrid.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; x, y: integer);var ARow, Which: integer; SourceRect, DestRect: TRect;begin if IsInADrawArea(x, y, ARow, Which) then begin SourceRect := Rect(0, 0, 23, 23); DestRect := Rect(175 - 1, (Row - TopRow) * DefaultRowHeight + 70 - 2, 175 + 23 - 1, (Row - TopRow) * DefaultRowHeight + 70 + 23 - 2); Canvas.CopyRect(DestRect, FGreenButtonImageS.Canvas, SourceRect); GridValue[Row].RowProperty.RowGreenButtonBeSelect := true; end else begin if GridValue[Row].RowProperty.RowGreenButtonBeSelect then begin SourceRect := Rect(0, 0, 23, 23); DestRect := Rect(175 - 1, (Row - TopRow) * DefaultRowHeight + 70 - 2, 175 + 23 - 1, (Row - TopRow) * DefaultRowHeight + 70 + 23 - 2); Canvas.CopyRect(DestRect, FGreenButtonImageD.Canvas, SourceRect); GridValue[Row].RowProperty.RowGreenButtonBeSelect := false; end; end;end;function TSkypeGrid.IsInADrawArea(x, y: integer; var ARow, Which: integer): Boolean;begin // Result := false; if (x > 175) and (x < 195) then begin if (y > (Row - TopRow) * 40 + 70) and (y < (Row - TopRow) * 40 + 90) then begin Result := true; end; end;end;procedure TSkypeGrid.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: integer);var ARow, Which: integer;begin if IsInADrawArea(x, y, ARow, Which) then begin GridValue[Row].RowProperty.MouseDown := true; end;end;procedure TSkypeGrid.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: integer);var ARow, Which: integer;begin if IsInADrawArea(x, y, ARow, Which) then begin if GridValue[Row].RowProperty.MouseDown then begin if assigned(OnSkypePhoneButtonEvent) then OnSkypePhoneButtonEvent(Sender, Row, GridValue[Row].SkypeGridValue.Email); // showmessage(''); end; GridValue[Row].RowProperty.MouseDown := false; end;end;procedure TSkypeGrid.StringGrid1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: integer; MousePos: TPoint; var Handled: Boolean);begin if WheelDelta = 120 then begin // bsSkinButton_shortMap.OnClick(bsSkinButton_shortMap); end else begin if WheelDelta = -120 then begin // bsSkinButton_CloseMap.OnClick(bsSkinButton_CloseMap); end; end;end;procedure TSkypeGrid.CreateImage;begin // FSelectBackImage := TImage.Create(Self); FGridHeadImage := TImage.Create(Self); FGreenButtonImageS := TImage.Create(Self); FGreenButtonImageD := TImage.Create(Self); // FSelectBackImage.Picture.LoadFromFile('ico/backg.bmp'); FGridHeadImage.Picture.LoadFromFile('ico/head.bmp'); FGreenButtonImageS.Picture.LoadFromFile('ico/p1.bmp'); FGreenButtonImageD.Picture.LoadFromFile('ico/p2.bmp'); // FSelectBackImage.Width := 286; FSelectBackImage.Height := 97; FGridHeadImage.Height := 41; FGridHeadImage.Width := 41; FGreenButtonImageD.Width := 23; FGreenButtonImageD.Height := 23; FGreenButtonImageS.Width := 23; FGreenButtonImageS.Height := 23; //end;function TSkypeGrid.GetSelectEMail: string;begin // if Row >= 0 then begin Result := GridValue[Row].SkypeGridValue.Email; end;end;end.