Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.04.25;
Скачать: [xml.tar.bz2];

Вниз

TStringGrid... ПАМАГИТЕ!   Найти похожие ветки 

 
koks   (2002-04-12 13:34) [0]

Уважаемые мастера - уже 2 дня бьюсь над проблемой - не хватает мозгов ее понять. Задача: есть TStringGrid, которая используется для ввода данных. Пользователь может по ней перемещаться и вводить только цифры. TStringGrid подсвечивает сфокусированную ячейку и форматирует число... (до сих пор все работает) Но вот встала дополнительная задача - необходимо чтобы TStringGrid подсвечивала заголовок рядя и колонки сфокусированного в данный момент элемента.
Идея: cоздал 2 открытых логических массива FarColumns FarRows - устанавливаю у них в ture только тот элемент, который соответствует выделенной в данной момент клетке - далее - условие на отображение в OnDrawCell.
Код:

procedure TfmEnterPrices.PrepareGrid; {вызывается в OnCreate}
begin {формы}
sgData.RowCount := 12; {<- sgData: TStringGrid}
SetLength(FArRows, 12);
FalseArray(FArRows); {<- FalseAffay "фалсит" все элементы}
sgData.ColCount := 10; {массива описанного как array of boolean
SetLength(FArColumns, 10);
FalseArray(FArColumns);
end;

{Обработчик OnSelectCell}
procedure TfmEnterPrices.sgDataSelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
FalseArray(FArRows);
FalseArray(FArColumns);
FArRows[ARow] := true;
FArColumns[ACol] := true;
CanSelect := true;
end;

{обработчик OnDrawCell}

procedure TfmEnterPrices.sgDataDrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
var
TextToPaint: string;
begin
with Sender as TStringGrid do
begin
if not (gdFixed in State) then
with Canvas do
begin
if (gdFocused in State) then
begin
Brush.Color := clRed;
Font.Color := clWhite;
Font.Style := [];
end
else
begin
Brush.Color := clWhite;
Font.Color := clBlack;
Font.Style := [];
end;
FillRect(Rect);
TextToPaint := sgData.Cells[ACol, ARow];
if not (Length(TextToPaint) = 0) then
TextToPaint := FormatFloat("# ##0.00", StrToFloat(Cells[ACol, ARow]))
Else
TextToPaint := "";
TextOut(Rect.Right - TextWidth(TextToPaint) - 2, Rect.Top + 1, TextToPaint);
end
else
with Canvas do
begin
if FArRows[ARow] or FArColumns[ACol] then
begin
Brush.Color := clBlack; {ВОТ ЗДЕСЬ ДОЛЖНО ПЕРЕ-}
Font.Color := clWhite; {РИСОВЫВАТЬ}
end
else
begin
Brush.Color := clBtnFace;
Font.Color := clBlack;
end;
FillRect(Rect);
Font.Style := [fsBold];
TextToPaint := sgData.Cells[ACol, ARow];
TextOut(Rect.Left + (Rect.Right - Rect.Left - TextWidth(TextToPaint)) div 2,
Rect.Top, textToPaint);
end;
end;
end;

Ошибок не выдает ! НО НЕ РАБОТАЕТ - ПРОСТО НЕ ПОДСВЕЧИВАЕТ строку или столбец и все тут....
Пробовал сбрасывать DefaultDrawing - то же самое....


 
Song   (2002-04-12 13:41) [1]

Вы сначала что-то делаете с канвасом, а потом его очищаете (FillRect) и хотите, чтобы на нём что-то оставалось :))


 
Dimka Maslov   (2002-04-12 14:21) [2]

procedure TfmEnterPrices.sgDataDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
State: TGridDrawState);
var
S: String;
X, Y: TColor;
W: Integer;
Bold: Boolean;
begin
with Sender as TCustomGrid do begin
Bold:=True;
if (ARow = 0) then Bold:=Col=ACol
else if (ACol = 0) then begin
if FixedCols = 0 then Bold:=False else Bold:=Row=ARow;
end else Boldt:=False;
if Bold then Canvas.Font.Style:=[fsBold];
S:=Cells[ACol, ARow];
W:=Canvas.TextWidth(S);
Y:=ARect.Top+2;
X:=ARect.Left+1;
if gdFocused in AState then Canvas.Brush.Color:=clWindow
else Canvas.Brush.Color:=Color;
if gdFixed in AState then begin
Canvas.Brush.Color:=FixedColor;
Inc(X);
end;
Canvas.TextRect(ARect, X, Y, S);
Canvas.Font.Style:=[];
end;
end;



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

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

Наверх





Память: 0.45 MB
Время: 0.005 c
14-81035
lipskiy
2002-03-19 03:10
2002.04.25
Как Аську 2001b под Win2k заставить видеть коннект и дисконнект?


7-81098
star
2002-01-24 17:45
2002.04.25
О точных временных интервалах ...


1-80881
snoup
2002-04-14 01:07
2002.04.25
Вот сегодня скачал RX Library, пожалуйста подскажите как, что,


1-80878
Демон
2002-04-14 10:47
2002.04.25
HELP!!! JPEG в BMP


14-81046
lipskiy
2002-03-19 21:45
2002.04.25
По поводу XP и убитого винта - шутка дубль два или что это?





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский