Модератор: Модераторы
user89 » 15.07.2015 18:28:18
*Rik* » 15.07.2015 20:29:41
*Rik* » 17.08.2015 23:04:33
user89 » 15.09.2015 17:00:58
*Rik* » 15.09.2015 17:23:21
user89 писал(а):На скринах Дизель-Паскаля (тот, что в Линуксе) очень красивый заголовок формы. Там буквы обведены контуром. Тема оформления ClearLooks вроде подходит, но в заголовке окна, буквы контуром не обводятся. Облазил все настройки шрифтов, не нашел... Хочу сделать, как на картинке ниже.
user89 » 15.09.2015 18:11:25
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<style>
.header {
margin:20px; width:450px; padding:4px;
text-align:center; color:#fff;
border:1px solid #4E76A8;
border-radius:3px;
font:700 12px verdana;
background: linear-gradient(#B2CCED 0%,#8CB0DC 50%,#86ABD9 51%,#7AA1D1 100%);
text-shadow: #4E76A8 1px 0 0px, #4E76A8 0 1px 0px, #4E76A8 -1px 0 0px, #4E76A8 0 -1px 0px, #4E76A8 0 0 1px;
}
</style>
<body>
<div class="header">Предприниматель УСН-6</div>
<div class="header">Редактировать запись</div>
</body>
</html> Kemet » 23.09.2015 16:12:38
*Rik* » 23.09.2015 18:06:22
Kemet писал(а):с текущей версией fpspreadsheet CrossMachine не собирается.
Юра, можешь добавить в проект tvplanit из lazarus ccr?
function TCustomMaskEdit.RestoreMask(const NewText: String): Boolean;
begin
if FMaskIsPushed and (not IsMasked) then
begin
FMaskIsPushed := False;
SetCharCase(ecNormal);
ClearInternalMask(FMask, FMaskLength);
System.Move(FSavedMask[1], FMask[1], SizeOf(TInternalMask));
FMaskLength := FSavedMaskLength;
ClearInternalMask(FSavedMask, FSavedMaskLength);
SetMaxLength(FMaskLength);
FTextOnEnter := inherited RealGetText;
Result := True;
end
else
begin
Result := False;
end;
// if NewText = old Text the next statement will do nothing,
// and NO mask will appear, so Clear first ...
if IsMasked then Clear;
Text := NewText;
end;
Kemet » 24.09.2015 18:32:02
*Rik* писал(а):tvplanit надо смотреть, потребуется время. У меня в на линуксе c XFCE он поставился, но не все компоненты работают, некоторые падают. Скажи какие компоненты необходимы, я попробую начать с них, если получится, будет доступно опционально при сборке из исходного кода..
ogorodov » 19.10.2015 12:17:39
*Rik* » 19.10.2015 13:15:41
ogorodov писал(а):Привет Rik а есть где нибудь пример использования TxDBGrid ... что он вообще из себя представляет
XDBGrids.GetDataSortField := @GetDBSortingField;
XDBGrids.AutoSortDataSet:= @OnAutoSortDataset;procedure GetDBSortingField(DataSet: TDataSet; var SortedFieldName: string; var Desc: Boolean);
var
S: string;
I, L: Integer;
xDBF: TxDbf;
begin
SortedFieldName := '';
Desc:= False;
{$IFDEF IBX}
if DataSet is TIBDataSet then
begin
S := UTF8UpperCase(TIBDataSet(DataSet).OrderFields);
if S <> '' then
begin
I := Pos(',', S);
if I > 0 then
begin
L := Length(S);
Delete(S, I, L - I + 1);
end;
I := Pos(' DESC', S);
if I > 0 then
begin
Desc := True;
Delete(S, I, 5);
end;
end;
SortedFieldName := Trim(S);
end
else
{$EndIf}
{$IfDef ZEOS}
if DataSet is TZAbstractRODataset then
begin
S := UTF8UpperCase(TZAbstractRODataset(DataSet).SortedFields);
if S <> '' then
begin
I := Pos(',', S);
if I > 0 then
begin
L := Length(S);
Delete(S, I, L - I + 1);
end;
Desc := TZAbstractRODataset(DataSet).SortType = stDescending;
end
else
if DataSet is TZQuery then;
begin
S := UTF8UpperCase(TZQuery(DataSet).IndexFieldNames);
if S <> '' then
begin
I := Pos(',', S);
if I > 0 then
begin
L := Length(S);
Delete(S, I, L - I + 1);
end;
Desc := False;
end
end;
SortedFieldName := Trim(S);
end
else
{$ENDIF}
if DataSet is TxDbf then
begin
xDBF := TxDbf(DataSet);
S := xDBF.IndexName;
if S <> '' then
begin
for I := 0 to xDBF.Indexes.Count - 1 do
begin
if xDbf.Indexes.Items[I].IndexFile = S then
begin
SortedFieldName := xDbf.Indexes.Items[I].SortField;
Desc := ixDescending in xDbf.Indexes.Items[I].Options;
Break;
end;
end;
end;
end;
end;
procedure OnAutoSortDataset(DataSet: TDataSet; Column: TxColumn; CellCursorPos: TCellCursorPos);
var
DIDef: TDbfIndexDef;
begin
{$IFDEF IBX}
if DataSet is TIBCustomDataSet then
begin
if CellCursorPos = ccpTop then
begin
if Column.Sorted = soxAscending then
begin
TIBCustomDataSet(DataSet).OrderFields := Column.FieldName + ' DESC';
Column.Sorted := soxDescending;
end
else
begin
TIBCustomDataSet(DataSet).OrderFields := Column.FieldName;
Column.Sorted := soxAscending;
end;
end
else
begin
if Column.xSorted = soxAscending then
begin
TIBCustomDataSet(DataSet).OrderFields := Column.xFieldName + ' DESC';
Column.xSorted:= soxDescending;
end
else
begin
TIBCustomDataSet(DataSet).OrderFields := Column.xFieldName;
Column.xSorted:= soxAscending;
end;
end;
end
else
{$ENDIF}
{$IFDEF ZEOS}
if DataSet is TZQuery then
begin
if CellCursorPos = ccpTop then
begin
if Column.Sorted = soxAscending then
begin
TZQuery(DataSet).IndexFieldNames := Column.FieldName + ' DESC';
Column.Sorted:= soxDescending;
end
else
begin
TZQuery(DataSet).IndexFieldNames := Column.FieldName;
Column.Sorted:= soxAscending;
end;
end
else
begin
if Column.xSorted = soxAscending then
begin
TZQuery(DataSet).IndexFieldNames := Column.xFieldName + ' DESC';
Column.xSorted:= soxDescending;
end
else
begin
TZQuery(DataSet).IndexFieldNames := Column.xFieldName;
Column.xSorted:= soxAscending;
end;
end;
end
else
{$EndIf}
if DataSet is TCustomBufDataset then
begin
if CellCursorPos = ccpTop then
begin
TCustomBufDataset(DataSet).IndexFieldNames := Column.FieldName;
Column.Sorted:= soxAscending;
end
else
begin
TCustomBufDataset(DataSet).IndexFieldNames := Column.xFieldName;
Column.xSorted:= soxAscending;
end;
end
else
if DataSet is TxDbf then
begin
if CellCursorPos = ccpTop then
begin
DIDef := TxDbf(DataSet).Indexes.GetIndexByField(Column.FieldName);
if DIDef = nil then
TxDbf(DataSet).AddIndex(Column.FieldName, Column.FieldName, [ixCaseInsensitive]);
TxDbf(DataSet).IndexFieldNames := Column.FieldName;
if TxDbf(DataSet).IndexName <> '' then
Column.Sorted:= soxAscending;
end
else
begin
TxDbf(DataSet).IndexName := Column.xFieldName;
Column.xSorted:= soxAscending;
end;
end;
end;
ogorodov » 19.10.2015 13:30:10
*Rik* » 19.10.2015 15:40:01
ogorodov писал(а):Спасибо ... теперь понятно
Добавлено спустя 2 часа 14 секунд:
Попробовал ... все хорошо только при вызове процедуры ConfirmDrawColumnCell ... в параметре Rect всегда выдается область для двойной строки и для FieldName и для xFieldName ... немного неудобно приходиться вычислять положение для своего отображения
Да. Сетка сделана на основе кода стандартного грида, поэтому механизмы работы остались прежними. Даже если в столбце используется 2 поля, для сетки ни чего не поменялось, для неё все равно нужно отрисовать только одну ячейку, а уж сколько там полей, сетке без разницы, для неё как была одна ячейка, так одна и осталась..ogorodov писал(а):... похоже понял ... скорей всего отрисовка FieldName и xFieldName происходит за один раз ... я прав
Вернуться в Компилятор / язык программирования
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 0