» Вопросы по Delphi (до версии 2009) - часть 6

Aleksandr N
самый быстрый способ
var
b: array of byte;
s: string;
begin

SetLength(b, Length(S));
CopyMemory(@b[0], @s[1], Length(S));

end;

salexn1

Цитата:

s: string;

s: Ansistring;

ну и я тогда продолжу :)

в условии было:

Цитата:

Есть некая функция, входным параметром которой является array of Byte, а я хочу ей скормить либо Char, либо string

Код: procedure aaa(var x);
var
b: array of byte absolute x;
c: array of char absolute x;
s: string absolute x;
begin
writeln('byte');
writeln(b[0]);
writeln(b[1]);
writeln(b[2]);

writeln('char');
writeln(c[0]);
writeln(c[1]);
writeln(c[2]);

writeln('string');
writeln(s);
end;

var
b: array of byte;
s: string;
c: array of char;
begin
s := '12345';
setlength(b, 5);
setlength(c, 5);
b[0] := 33;
b[1] := 48;
b[2] := 64;

c[0] := 'a';
c[1] := 'b';
c[2] := 'c';

writeln('send as array of byte');
aaa(b);

writeln('send as array of char');
aaa(c);

writeln('send as string');
aaa(s);
end.

akaGM
Зачет!!!

Всем привет у меня вот такая задача. Необходимо отрисовать массив слов так как это делает функция DrawText - если ширина строки превышает ширину прямоугольника, в котором происходит отрисовка, то часть слов переносится на следующую строку. Ну вобщем смысл понятен я надеюсь. Задача усложняется тем, что это не просто массив слов, а массив записей, в каждой из них сам текст и свойства шрифта, с которыми будет отрисовано слово - жирность, подчеркнутость и наклон. Привожу свои куски кода.

Сама функция для отрисовки слова. Если прямоугольник нулевой - высчитывает ширину и высоту слова. Если нет - выводит текст.

type
tagDrawItem = record
pszText : AnsiString;
bWeight : Boolean;
bItalic : Boolean;
bUnderline: Boolean;
end;
PDrawItem = ^TDrawItem;
TDrawItem = tagDrawItem;

function Measure(hWnd: HWND; hdcIn: HDC; rcPaint: PRect; Data: TDrawItem): TSize;
const
dwHeight: Array [Boolean] of DWORD = (FW_NORMAL, FW_BOLD);
var
lf : TLogFont;
dwRet : DWORD;
phfnt : HFONT;
hfnt : HFONT;
oldfnt : HFONT;
txtSize: TSize;
rcTop : Integer;
begin

ZeroMemory(@Result, SizeOf(TSize));

phfnt := SendMessage(hWnd, WM_GETFONT, 0, 0);
if (phfnt <> 0) then
begin

ZeroMemory(@lf, SizeOf(TLogFont));
dwRet := GetObject(phfnt, SizeOf(TLogFont), @lf);
if (dwRet <> 0) then
begin

lf.lfWeight := dwHeight[Data.bWeight];
lf.lfItalic := Integer(Data.bItalic);
lf.lfUnderline := Integer(Data.bUnderline);

hfnt := CreateFontIndirect(lf);

end;

end;

if (hfnt <> 0) then
oldfnt := SelectObject(hdcIn, hfnt)
else
oldfnt := 0;

GetTextExtentPoint32(
hdcIn,
LPCSTR(Data.pszText),
lstrlen(LPCSTR(Data.pszText)),
txtSize
);

if (rcPaint <> nil) then
begin
rcTop := rcPaint.Top + (((rcPaint.Bottom - rcPaint.Top) - txtSize.cy) div 2);
TextOut(
hdcIn,
rcPaint.Left,
rcTop,
LPCSTR(Data.pszText),
lstrlen(LPCSTR(Data.pszText))
);
end
else
begin
Result.cx := txtSize.cx;
Result.cy := txtSize.cy;
end;

if (hfnt <> 0) then
DeleteObject(hfnt);
if (oldfnt <> 0) then
SelectObject(hdcIn, oldfnt);

end;

И самое главная процедура для отрисовки слов на контексте. Сделано как шаблон для отладки. Понять хотя бы принцип.

procedure Draw2(h: HWND; dc: HDC; data: Array of TDrawItem; rc: PRect);
var
rect: TRect;
tm: TTextMetric;
i: Integer;
size: TSize;
l: Integer;
_f: Integer;
_l: Integer;
lead: Integer;
id: Integer;
begin

CopyRect(rect, rc^);
GetTextMetrics(dc, tm);

FillRect(dc, rect, GetStockObject(WHITE_BRUSH));

// сброс значений параметров.

l := 0;
_f := Low(data);
_l := High(data);

lead := tm.tmInternalLeading + tm.tmExternalLeading;

// перебор всех слов в строке.

for i := Low(data) to High(data) do
begin

// извлекаем ширину и высоту слова в пикселях. добавляем к ширине пробел.

size := Measure(h, dc, nil, data[i]);
Inc(l, size.cx);
Inc(l, tm.tmAveCharWidth);

// проверяем, выходит ли за пределы ширины окна суммарная ширина слов,
// которые отрисуем. ширину слов учитываем без последнего пробела.

if ((l - tm.tmAveCharWidth) > (rc^.Right - rc^.Left)) then
begin

// перед отрисовкой слов устанавливаем индекс последнего слова, которое
// будет завершающим в рисуемой строке.

_l := i - 1;

// удаляем ширину лишнего слова и ширину пробела после него.

Dec(l, size.cx);
Dec(l, tm.tmAveCharWidth);

// устанавливаем границы для отрисовки каждого слова в строке. для начала
// сдвигаем левую координату на определенное количество пикселей, чтобы
// уместить текст строки по центру от краев окна.

rect.Left := ((rc^.Right - rc^.Left) - l) div 2;
rect.Bottom := rect.Top + size.cy + lead;

// проходимся по индексам слов, которые отрисуем в строке. у каждого слова
// узнаем ширину и высоту. устанавливаем относительно этих показаний
// координаты правой границы, в которых будем отрисовывать слово. после
// отрисовки сдвигаем координату левой границы прямоугольника для отрисовки
// следующего слова.

for id := _f to _l do
begin
size := Measure(h, dc, nil, data[id]);
rect.Right := rect.Left + size.cx;
Measure(h, dc, @rect, data[id]);
//FrameRect(dc, rect, GetStockObject(LTGRAY_BRUSH));
Inc(rect.Left, size.cx);
Inc(rect.Left, tm.tmAveCharWidth);
end;

// так как ширина строки превысила ширину окна, то необходимо отрисовать
// оставшуюся часть строки в новых координатах. для этого сдвигаем
// верх и низ прямоугольника.

Inc(rect.Top, size.cy);
Inc(rect.Top, lead);
Inc(rect.Bottom, size.cy);
Inc(rect.Bottom, lead);

// сбрасываем параметр ширины отрисовываемой части строки. устанавливаем
// индексы для итерации массива оставшихся слов для их отрисовки.

l := 0;
_f := i;
_l := High(data);

end;

// if ((l - tm.tmAveCharWidth) < (rc^.Right - rc^.Left)) and (i = High(data)) then
if (i = High(data)) then
begin

Dec(l, tm.tmAveCharWidth);

rect.Left := ((rc^.Right - rc^.Left) - l) div 2;
rect.Bottom := rect.Top + size.cy + lead;

for id := _f to _l do
begin
size := Measure(h, dc, nil, data[id]);
rect.Right := rect.Left + size.cx;
Measure(h, dc, @rect, data[id]);
//FrameRect(dc, rect, GetStockObject(LTGRAY_BRUSH));
Inc(rect.Left, size.cx);
Inc(rect.Left, tm.tmAveCharWidth);
end;

end;

end;

end;

Меняю размеры окна - некоторые строчки по центру, а некоторые со сдвигом. Кто знает как сделать все корректно - подскажите что подправить в if else условии. Не додумаюсь как нормлаьно сделать.

Как для разных объектов одного типа установить разную отрисовку? Для первого объекта я делал так:

Код: TMyPainter = class(TcxSheetPainter)
protected
procedure DrawHeaderBrick(I, J: Integer); override;
end
procedure TMyPainter.DrawHeaderBrick;
var ii: Integer;
begin
inherited;
//код для первого объекта
end;
procedure TForm1.cxSpreadSheet2CustomPaint(Sender: TObject;
var PainterClass: TcxSheetPainterClass);
begin
PainterClass := TMyPainter;
end;

Что-то совсем не идет у меня в последнее время кодирование...
Есть такой код:

Код:
type
TfrmServer = class(TForm)
procedure FormActivate(Sender: TObject);
private
public
protected
end;

type
TfrmFrame = class(TForm)
procedure frmFrameOnActivate(Sender: TObject);
private
public
end;

procedure TfrmServer.FormActivate(Sender: TObject);
begin
Application.CreateForm(TfrmFrame, frmFrame);
with frmFrame do
begin
WindowState := wsMinimized;
OnActivate := frmFrameOnActivate;
Visible := True;
Parent := frmServer;
end;
end;
end;

procedure TfrmFrame.frmFrameOnActivate(Sender: TObject);
begin
ShowMessage('Жопа, блин, какая-то');
end;

Maks150988

скриншот лучше запостить чтобы видно было где и что нормально отрисрвывается, а где нет

А можно сделать так, чтобы в моем консольном приложении работали все команды командной строки?

Ichigo2
Если только ты будешь считывать введенные команды и запускать их в командном интерпретаторе через Process

ArtSnegirev

Цитата:

запускать их в командном интерпретаторе

Вы имеете в виду запуск cmd.exe с параметрами?

Ichigo2

имелся в виду запуск в отдельном процессе, передача ему параметров и считывание результатов
перенаправление ввода-вывода консоли вобщем

Ichigo2
да, ant0ni02004 верно меня понял, например так:

function Process(CmdLine: string): Boolean;
var
    Si: TStartupInfo;
    Pi: TProcessInformation;
begin
ZeroMemory (@Si, SizeOf (Si));
Si.Cb := SizeOf (Si);
if not CreateProcess(nil, PChar (CmdLine), nil, nil, False, 0, nil, nil, Si, Pi) then begin
Application.MessageBox(PChar ('Ошибка запуска: ' + CmdLine), 'Ошибка', mb_IconError);
Result := False;
end else
Result := True;
CloseHandle(Pi.hProcess);
CloseHandle(Pi.hThread);
end;

Коллеги, помогите, пожалуйста, разрешить проблему.
Суть её в следующем: имеется таблица DBF типа dBase III plus, в которую экспортируются данные в формате ANSI (Windows), а не в OEM (DOS), что создаёт проблемы отображения данных в символьных полях!
В BDE настройки:
1. системные LANGDRIVER Pdox ANSI Cyrillic;
2. для DBASE LANGDRIVER dBASE RUS cp866
Знаю, что есть в классе TDataSet функция Translate(Src, Dest: PAnsiChar; ToOem: Boolean): Integer; virtual;, но как её использовать не знаю.
Как при открытии таблицы провести трансляцию, чтобы нормально отображались русские символы?
Если можно пример. Заранее спасибо.

А если в DBASE LANGDRIVER указать ANSI кодировку?

exteris
В BDE для DBASE русской ANSI кодировки нет.

EugeneBoss3
может лучше при экспорте выполнять преобразование ANSI в OEM?

ArtSnegirev
Проблема в том, что экспортируются данные из Microsoft SQL Server 2005 и DBF файл уже поставляется с данными, но в Delphi при открытии этого файла строковые поля в виде иероглифов!
Т.е. данные в таблице есть, как их преобразовать в читабельный формат в Delphi?

EugeneBoss3
Попробуй поставить в BDE для DBASE LANGDRIVER = 'ascii' ANSI (без префикса DBASE)

ArtSnegirev
Сегодня попробовал решить проблему по Вашему совету - символьные поля для таблицы ANSI стали отображаться правильно, но в системе есть много таблиц с кодировкой OEM, при их открытии проблемы с отображением те же!
Как же всё таки при открытии таблицы провести именно трансляцию, чтобы нормально отображались русские символы?

EugeneBoss3
если нужно только отобразить данные правильно, то попробуйте выполнять преобразование кодировки при прорисовке грида

Добрый день. Заранее прошу прощения за нубскую просьбу, но вот не делал никогда, и примеров не нашел.
Нужно сделать компоненту, производную от TPageControl, которая на своих TTabSheet содержит TRichEdit с включеным свойством align := alclient;.
То-есть, создаешь TTabSheet а там уже свой TRichEdit во весь TTabSheet. Может кто-нибудь сделать и откоментировать, пожалуйста?

P.S. Заготовка:
[more]
Код:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;

type
TTabRichEdit = class(TTabSheet)
private
RichEdit: TRichEdit;
end;

type
TForm1 = class(TForm)
PageControl1: TPageControl;
Button1: TButton;
procedure FormShow(Sender: TObject);
private
{ Private declarations }
procedure CreatePage();
public
{ Public declarations }
end;

var
Form1: TForm1;
TabRichEdit1: TTabRichEdit;

implementation

{$R *.dfm}


procedure TForm1.CreatePage();
begin
TabRichEdit1 := TTabRichEdit.Create(PageControl1);
TabRichEdit1.PageControl:= PageControl1;
TabRichEdit1.RichEdit := TRichEdit.Create(TabRichEdit1);
PageControl1.ActivePage := TabRichEdit1;
TabRichEdit1.Caption := 'Tab RichEdit ('+IntToStr(PageControl1.ActivePageIndex+1)+')';
TabRichEdit1.RichEdit.Align:= alClient;
TWinControl(TabRichEdit1.RichEdit).Parent := TabRichEdit1;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
CreatePage();
end;

end.

Gnom3


Код:
TTabRichEdit = class(TTabSheet)
private
RichEdit: TRichEdit;
public
constructor Create(AOwner:TComponent);
end;
......
procedure TTabRichEdit .Create(AOwner:TComponent);
begin
inherited Create(AOwner);
RichEdit:=TRichEdit.Create(self.Owner);
RichEdit.Parent:=self;
RichEdit.Align:=alClient;
RichEdit.Visible:=true;
end;
.......
procedure TForm1.CreatePage;
begin
with TTabRichEdit.Create(Self) do
begin
PageControl:=PageControl1;
Caption:='....';
{итд}
end;
end;

ant0ni02004
Благодарю . Тоже уперся именно в то, что плясать нужно иенно от TTabSheet а не TPageControl. В том и была глобальная засада, что TPageControl компонент уже составной, и TTabSheet еще не создан. А полноценный компонент писать ради того, для чего мне нужно - не имеет смысла.

ArtSnegirev

Цитата:

если нужно только отобразить данные правильно, то попробуйте выполнять преобразование кодировки при прорисовке грида

Я и прошу подсказать, как именно это преобразование сделать!

EugeneBoss3
function ConvertAnsiToOem(const S: String): String;
{ ConvertAnsiToOem translates a string into the OEM-defined character set }
{$IFNDEF WIN32}
var
Source, Dest : array[0..255] of Char;
{$ENDIF}
begin
{$IFDEF WIN32}
SetLength(Result, Length(S));
if Length(Result) > 0 then
AnsiToOem(PChar(S), PChar(Result));
{$ELSE}
if Length(Result) > 0 then
begin
AnsiToOem(StrPCopy(Source, S), Dest);
Result := StrPas(Dest);
end;
{$ENDIF}
end; { ConvertAnsiToOem }


procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState);
begin
(Sender as TDBGrid).Canvas.TextRect(Rect, Rect.Left + 2,
Rect.Top + 2, ConvertAnsiToOem(self.Table1.FieldByName('newfield').AsString));
end;

ArtSnegirev
Спасибо за пример.
Примерно об этом я и думал, но для использования функции нужно форматы и имена полей таблицы знать.
И это только на отображение в гриде, а нужно перекодировать символьные данные в таблице, для последующего использования.
А пример использования функции Translate(Src, Dest: PAnsiChar; ToOem: Boolean): Integer; virtual; случайно не подскажешь?

EugeneBoss3
Ну для перекодировки знать форматы и имена полей необязательно, т.к. можно обходить все поля и только если (Field.DataType = ftString), то выполнять перекодирование.
А заставить работать процедуру Translate мне не удалось, да и зачем она нужна если ConvertAnsiToOem из поста выше делает то же самое без ошибок (кстати в хелпе написано, что она работает только на BDE)!?

Не поделится ли кто опытом для решения следующей задачи:
сделать в приложении настройку используемого шрифта для форм.
Проблема в том, что при изменении шрифта с меньшего на больший Label будут "залазить" на Edit контролы.
Решал ли кто такую задачу? Поделитесь плиз!

salexn1
Попытаться манипулировать Align, Anchors, AutoSize, использовать TLabeledEdit, расположить элементы соответствующим удобным образом, в конце концов, написать некую свою процедуру для изменения расположения элементов с учетом потребностей (куда оно должно деваться, если слишком большое?? ) если стандартных средств недостаточно ... Универсального рецепта, наверное, не существует.