挖掘DrawGrid/StringGrid的潜力1

 unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, GDIPAPI, GDIPOBJ, Themes, Dialogs, Grids, StdCtrls; type TForm1 = class(TForm) Grid: TDrawGrid; Label1: TLabel; procedure FormCreate(Sender: TObject); procedure GridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure GridMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure GridMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure GridMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } HotCol, HotRow, LastCol, LastRow: integer; CheckItem1Width, CheckItem2Width: Integer; SelectedStartColor: TColor; SelectedEndColor: TColor; BmpGrid: TBitmap; ImgUnCheck, ImgCheck: TGPBitmap; function OnMouseHit(X, Y: Integer; CheckClass: Integer): Boolean; public { Public declarations } end; var Form1: TForm1; CurrentPath: string; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); var i: Integer; begin SelectedStartColor := $00FCF1EB; SelectedEndColor := $00F8DDCF; CurrentPath := ExtractFilePath(Application.ExeName); BmpGrid := TBitmap.Create; Grid.ColWidths[0] := 30; Grid.ColWidths[1] := 600; for i := 0 to Grid.RowCount - 1 do Grid.RowHeights[i] := 100; ImgUnCheck := TGPBitmap.Create(CurrentPath + 'unChecked.png'); ImgCheck := TGPBitmap.Create(CurrentPath + 'Checked.png'); end; procedure TForm1.GridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure DrawGridText(s: string; ACanvas: TCanvas; FontStyle: TFontStyles; r: TRect); begin ACanvas.Font.Style := FontStyle; DrawText( ACanvas.Handle, PCHAR(s), Length(s), r, DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or DT_LEFT); end; var ACanvas: TCanvas; ARect, R: TRect; Text: string; DTFormat: integer; g: TGpGraphics; Img: TGPBitmap; H, W: integer; ElementDetails: TThemedElementDetails; begin try ARect := Rect; OffsetRect(ARect, -ARect.Left, -ARect.Top); ARect.Bottom := ARect.Bottom - 16; BmpGrid.Width := ARect.Right; BmpGrid.Height := ARect.Bottom; ACanvas := BmpGrid.Canvas; ACanvas.Font := Font; if gdSelected in State then begin //选中时处理 ACanvas.Font.Color := clBlack; ACanvas.Brush.Color := $00F1BA9C; // $00F9F7F6; ACanvas.FillRect(ARect); ACanvas.Brush.Style := bsClear; ACanvas.Font.Color := clWhite; end else if ARow mod 2 = 0 then begin ACanvas.Font.Color := clBlack; ACanvas.Brush.Color := $00F0FFFF; // $00F9F7F6; ACanvas.FillRect(ARect); end else begin ACanvas.Font.Color := clBlack; ACanvas.Brush.Color := clWhite; ACanvas.FillRect(ARect); end; ACanvas.Brush.Style := bsClear; r := ARect; if ACol = 0 then begin g := TGPGraphics.Create(ACanvas.Handle); try Img := ImgUnCheck; g.DrawImage( Img, (r.Right - img.GetWidth) div 2, 0, Img.GetWidth, Img.GetHeight); finally FreeAndNil(g); end; end else begin ACanvas.Font.Color := clBlack; r := ARect; r.Bottom := 16; DrawGridText('测试用标题' + IntToStr(ARow), ACanvas, [fsBold], r); OffsetRect(r, 0, 16); DrawGridText('测试1:', ACanvas, [], r); OffsetRect(r, 0, 16); DrawGridText('测试1:', ACanvas, [], r); OffsetRect(r, 0, 16); DrawGridText('测试1:', ACanvas, [], r); ACanvas.Font.Color := clGreen; OffsetRect(r, 0, 16); Text := '链接1'; DrawGridText(Text, ACanvas, [fsUnderline], r); CheckItem1Width := ACanvas.TextWidth(Text); OffsetRect(r, CheckItem1Width + 20, 0); Text := '链接2'; DrawGridText(Text, ACanvas, [fsUnderline], r); CheckItem2Width := ACanvas.TextWidth(Text); end; finally TStringGrid(Sender).Canvas.Draw(Rect.Left, Rect.Top, BmpGrid); end; end; function TForm1.OnMouseHit(X, Y, CheckClass: Integer): Boolean; var r, DestRect1, DestRect2: TRect; LastHotCol, LastHotRow: integer; begin Result := False; try LastHotCol := HotCol; LastHotRow := HotRow; Grid.MouseToCell(X, Y, HotCol, HotRow); if (HotCol = -1) or (HotRow = -1) then Exit; if (HotCol <> LastHotCol) or (HotRow <> LastHotRow) then begin if Grid.Cursor <> crDefault then Grid.Cursor := crDefault; end; case HotCol of 1: //标题 begin r := Grid.CellRect(HotCol, HotRow); DestRect1 := Rect(0, 64, CheckItem1Width, 78); //第一个链接的坐标 DestRect2 := Rect(CheckItem1Width + 20, 64, DestRect1.Right + 20 + CheckItem2Width, 78); //第二个链接的坐标 OffsetRect(DestRect1, r.Left, r.Top); OffsetRect(DestRect2, r.Left, r.Top); if PtInRect(DestRect1, Point(X, Y)) then begin Grid.Cursor := crHandPoint; if CheckClass = 3 then ShowMessage('点击' + IntToStr(HotRow) + '的第一个链接'); end else if PtInRect(DestRect2, Point(X, Y)) then begin Grid.Cursor := crHandPoint; if CheckClass = 3 then ShowMessage('点击' + IntToStr(HotRow) + '的第二个链接'); end else begin Grid.Cursor := crDefault; end; end; else begin Grid.Hint := ''; if Grid.Cursor <> crDefault then begin Grid.Cursor := crDefault; Application.HideHint; end; end; end; except end; end; procedure TForm1.GridMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then OnMouseHit(X, Y, 2); end; procedure TForm1.GridMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if not (ssLeft in Shift) then OnMouseHit(X, Y, 1); end; procedure TForm1.GridMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then OnMouseHit(X, Y, 3); end; end.