Форум: "Основная";
Текущий архив: 2002.07.15;
Скачать: [xml.tar.bz2];

Вниз

CheckBox.Parent:=DrawGrid; - почему чекбокс ненажимаемый?   Найти похожие ветки 

← →
greenrul   (2002-06-29 18:28) [0]

Нужно чтобы 50 динамически создаваемых чекбоксов скроллировались вместе в DrawGrid... Попробовал таким способом, но мне посоветовали CreateWindow - я пару примеров (вроде TrackBar[i]:=CreateWindow("TRACKBAR_CLASS","STB",WS_CHILD or WS_VISIBLE or WS_TABSTOP or TBS_VERT or TBS_BOTH or TBS_AUTOTICKS,5+i*5,25,20,50, MainWnd,IDC_TRACKBARS[i], hInstance, nil); ) посмотрел, но нихрена не понял...

Я не профи, запутался, прошу помочь

---

← →
MBo   (2002-06-29 19:28) [1]

"TRACKBAR_CLASS" слабо напоминает чекбокс ;) (вот кнопка - его сестра родная)

Поиском поищи про CheckBox в StringGrid (недавно были решения и с объектам TCheckBox и c рисованием чекбоксов в Stringgrid)

---

← →
greenrul   (2002-06-29 19:42) [2]

Если вы про
http://delphi.mastak.ru/cgi-bin/forum.pl?look=1&id=1024585109&n=0

то там ничего толкового не нашел 8(


в ФАКе есть пример, но при скроллинге он "умрет"

---

← →
Бурундук   (2002-06-29 22:57) [3]

Вариант с рисованием чекбоксов:


TForm1 = class(TForm)
SGrid: TStringGrid;
ImgList: TImageList;
procedure SGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure FormCreate(Sender: TObject);
procedure SGridMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SGridMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SGridSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure SGridKeyPress(Sender: TObject; var Key: Char);
private
DownCol: Integer;
DownRow: Integer;
public
{-------------- CheckBox --------------------------------}
function GetCheckBoxRect(CellRect: TRect): TRect;
function CheckBoxValue(ACol, ARow: Integer): Boolean;
function IsCheckBoxCol(ACol: Integer): Boolean;
function PressCheckBox(ACol, ARow: Integer): TRect;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

const
CheckBoxCol = 2;
imgChecked = 0;

{--------------------------------------------------------------}

function TForm1.IsCheckBoxCol(ACol: Integer): Boolean;
begin
Result := ACol = CheckBoxCol;
end;

function TForm1.GetCheckBoxRect(CellRect: TRect): TRect;
var W, H: Integer;
begin
W := CellRect.Right - CellRect.Left;
H := CellRect.Bottom - CellRect.Top;
Result := Classes.Rect(0, 0, 16, 16);
OffSetRect(Result,
(CellRect.Right + CellRect.Left - Result.Right) div 2,
CellRect.Top + (H - Result.Bottom) div 2 );
end;

function TForm1.CheckBoxValue(ACol, ARow: Integer): Boolean;
begin
Result := SGrid.Cells[ACol, ARow] = "True";
end;

function TForm1.PressCheckBox(ACol, ARow: Integer): TRect;
begin
with SGrid do
if Cells[ACol, ARow] = "True" then Cells[ACol, ARow] := "False"
else Cells[ACol, ARow] := "True";
end;

{-------------------------------------------------------------}

procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
DownCol := -1;
DownRow := -1;

SGrid.DefaultDrawing := False;
end;

procedure TForm1.SGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var CbRect, TxtRect: TRect;
EdgeStyle: Cardinal;
imgSort: Integer;
begin
with Sender as TStringGrid do
begin

Canvas.Brush.Color := Color;
Canvas.Font.Color := clWindowText;
Canvas.Pen.Width := 1;

if (gdFixed in State) then
Canvas.Brush.Color := clBtnFace
else if (gdSelected in State) and (not (gdFocused in State)) then
begin
Canvas.Brush.Color := clHighlight;
Canvas.Font.Color := clWhite;
end else
Canvas.Brush.Color := Color;

Canvas.FillRect(Rect);

// to be continued


---

← →
Бурундук   (2002-06-29 22:58) [4]



if IsCheckBoxCol(ACol)and(ARow >= FixedRows) then
begin
// CheckBox
CbRect := GetCheckBoxRect(Rect);

Canvas.Brush.Color := Color;
Canvas.FillRect(CbRect);
DrawEdge(Canvas.Handle, CbRect, EDGE_SUNKEN, BF_RECT);

if CheckBoxValue(ACol, ARow) then
begin
// Для прямоугольника 16х16
Canvas.Pen.Width := 2;
Canvas.Pen.Color := cl3DDkShadow;
Canvas.MoveTo(CbRect.Left+2, CbRect.Top+6);
Canvas.LineTo( (CbRect.Left + CbRect.Right-2) div 2, CbRect.Bottom-5);
Canvas.LineTo(CbRect.Right-3, CbRect.Top+5);

Canvas.MoveTo( (CbRect.Left + CbRect.Right-2) div 2, CbRect.Bottom-5);
Canvas.LineTo( (CbRect.Left + CbRect.Right-2) div 2, CbRect.Bottom-4);

InflateRect(CbRect, -2, -2);
Canvas.FrameRect(CbRect);
// Вместо этого можно хранить изображение галочки в ImageList
// ImgList.Draw(Canvas, CbRect.Left, CbRect.Top, imgChecked);
end;

end
else
begin
// Text
Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2, Cells[ACol, ARow]);
end;

// Фиксированные ячейки
if gdFixed in State then
begin
if (ACol = DownCol)and(ARow = DownRow) then EdgeStyle := BDR_SUNKENINNER
else EdgeStyle := BDR_RAISEDINNER;
DrawEdge(Canvas.Handle, Rect, EdgeStyle, BF_RECT);
end;

// FocusRect
if (gdFocused in State) then Canvas.DrawFocusRect(Rect);
end;
end;

procedure TForm1.SGridMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Rect, CbRect: TRect;
begin
with Sender as TStringGrid do
begin
MouseToCell(X, Y, DownCol, DownRow);

if (DownRow = -1)or(DownCol = -1)then Exit;

if IsCheckBoxCol(DownCol)and(DownRow >= FixedRows) then
begin
Rect := CellRect(DownCol, DownRow);
CbRect := GetCheckBoxRect(Rect);
if PtInRect(CbRect, Point(X, Y)) then PressCheckBox(DownCol, DownRow);
end;

end;
end;

procedure TForm1.SGridMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
DownCol := -1;
DownRow := -1;
end;

procedure TForm1.SGridSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
begin
with Sender as TStringGrid do
if IsCheckBoxCol(ACol) then Options := Options - [goEditing]
else Options := Options + [goEditing];
end;

procedure TForm1.SGridKeyPress(Sender: TObject; var Key: Char);
begin
with Sender as TStringGrid do
if (Key = " ") and IsCheckBoxCol(Col)and(Row >= FixedRows) then
PressCheckBox(Col, Row);
end;

end.




---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.07.15;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.012 c