Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 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.011 c
3-47117
Kudatsky
2002-06-17 14:04
2002.07.15
TQuery+TUpdateSQL


7-47825
Hel
2002-04-22 15:23
2002.07.15
Как скрыть окно, появляющеееся после печати?


6-47642
Dmitry100
2002-05-03 14:41
2002.07.15
UDP в Windos 2000


3-47124
Ramil
2002-06-21 21:09
2002.07.15
У кого получался сетевой IB под win95/98


3-47119
olban
2002-06-21 08:01
2002.07.15
Доступ к БД





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский