Вопросы и решения

[LexBell]

Здесь задаем вопросы и выкладываем решения различных задач.

Добавлено через 4 секунды
Возник следующий вопрос - возможно-ли локально, для VCL-окна отключить сглаживание шрифтов (Cleartype)? доступ к окну только по хендлу, хендл известен.

 

[Shegorat]

Возник следующий вопрос - возможно-ли локально, для VCL-окна отключить сглаживание шрифтов (Cleartype)? доступ к окну только по хендлу, хендл известен.

Для отдельного окна/приложения вроде можно создать свой шрифт, который потом использовать в тексте. Чтобы отключить сглаживание нужно создавать шрифт с флагом NONANTIALIASED_QUALITY (подробнее CreateFont - MSDN)

  myFont:= CreateFont(0, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, NONANTIALIASED_QUALITY, FF_DONTCARE, PChar('Arial'));
  SendMessage(myHandle, WM_SETFONT, myFont, 0);

Как-то так.

 

[shidow]

Нубский вопрос :-[
Есть два текста текст1 и текст2.
Нужно сделать чтоб при нажатие на кнопку в edit выводилась надпись текст1 если еще раз нажать текст2 потом опять текст1 и т.д.

 

[David.D.Rocco]

shidow,

Спойлер

var
  s1, s2: string;
  istrue: boolean = true;

procedure TForm1.FormCreate(Sender: TObject);
begin
  s1:='text1'; s2:='text2';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if istrue then Edit1.Text:=  s1
    else Edit1.Text:= s2;
  istrue:=not istrue;
end;

 

[shidow]

David.D.Rocco,
Спасибо
И еще один вопрос. А если текстов больше двух :-[

 

[David.D.Rocco]

shidow, как то так

Спойлер

var
  s1, s2, s3: string;
  i: integer = 1;

procedure TForm1.FormCreate(Sender: TObject);
begin
  s1:='text1'; s2:='text2'; s3:='text3';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if i = 1 then Edit1.Text:= s1
    else if i = 2 then Edit1.Text:= s2
      else if i = 3 then Edit1.Text:= s3;
  i:=i+1;
  if i=4 then i:=1;
end;

 

[shidow]

David.D.Rocco,
Спасибо :up:

 

[DaRKdemoN]

просьба к знающим: накатать простой пример подгрузки битмапа с альфо каналом.
PS. Всётаки заинтересовался этим.
PPS. Всем отозвавшимся буду премного благодарен.

 

[Shegorat]

DaRKdemoN
Так нужен именно альфа-канал или частичная прозрачность (вырезание определенного цвета)?

 

[DaRKdemoN]

Так нужен именно альфа-канал или частичная прозрачность (вырезание определенного цвета)?

Альфа канал (там и полупрозрачность есть). С вырезанием не то получается, так как надо и полупрозрачность (уже писал,но повторюсь - у InnoUI есть это).

 

[Avangard]

Как в .dll засунуть файлы (картинки и др.)?
[hr]
Как в длл засунуть файлы Gnom.

Всем доброго времени суток. Не могу разобраться с GDI+. Не хочет он рисовать на окне WizardForn. Тупо пропускает загрузку и все. Выручайте.

library imgs;

uses
  Windows, GDIPAPI, GDIPOBJ, GDIPUTIL;

{$R *.res}

var
  img: TGPImage;
  graph: TGPGraphics;
  graphp: Pointer;
  p: TGPRectF;

procedure create_logo(wnd: HWND; FileName: PChar; X, Y, W, H: Integer) stdcall;
begin
try
img := TGPImage.Create(filename);

p.X:=x;
p.Y:=y;
p.Width:=w;
p.Height:=h;

graph := TGPGraphics.Create(getdc(wnd));
graph.DrawImage(img, p);
GdipCreateFromHWND(wnd, graphp);
UpdateWindow(wnd);
except
end;
end;

procedure Free(); stdcall;
begin
img.Free;
graph.Free;
GdiplusShutdown(1);
end;

exports create_logo;
exports free;

begin
end.

Выручайте. При использовании модуля DMWAPI кнопки на форме (hwnd) не хотят нормально отображаться. Как исправить?

Спойлер: Исходник

library isAero;

uses
Windows,Composition,DWMAPI;

var
ISAeroGlassSourceM: TMargins;
ISAeroGlassSourceP: PMargins;
Blur: PDWMBlurBehind;
ISAeroGlassSourceE: longbool;
ps : PAINTSTRUCT;
dc : HDC;

function isAeroAddGlass(Handle: HWND; Top, Left, Right, Bottom: Integer): Boolean; stdcall;
begin
with ISAeroGlassSourceM do begin
cxRightWidth := Top;
cxLeftWidth := Left;
cyTopHeight := Right;
cyBottomHeight := Bottom;
end;
dc := BeginPaint(Handle, ps);
CompositionServices.ExtendFrameIntoClientArea(Handle, @ISAeroGlassSourceM);
DwmEnableBlurBehindWindow(Handle, Blur);
EndPaint(Handle, ps);
UpdateWindow(Handle);
end;

function isAeroGlassEnabled: Boolean; stdcall;
begin
DwmIsCompositionEnabled(@ISAeroGlassSourceE);
result:= ISAeroGlassSourceE;
end;

procedure isAeroFree(); stdcall;
begin
FreeDWMLibrary;
end;

exports isAeroAddGlass;
exports isAeroGlassEnabled;
exports isAeroFree;

begin
end.

 

[Rikill]

Gnom, дал бы хотябы ссылку нормальную, думаешь человек не гуглил?
[hr]Думаю, что нет. там срзу в первых-же ссылках есть ответы. Gnom.

 

[LexBell]

MasteR, ООО, там все элементарно - скрываешь эти кнопки, и создаешь кастомные вместо родных - будучи созданными после применения стекла, кнопки нормально отрисовываются, проверял лично. Есть еще такой вариант без отрисовки контролов заново. Но я его не скажу. Кстати, Репачек, ты запалился

 

[DaRKdemoN]

Всем доброго времени суток. Не могу разобраться с GDI+. Не хочет он рисовать на окне WizardForn. Тупо пропускает загрузку и все. Выручайте.

там нету перерисовки, вот и не видно картинки.

Кстати, Репачек, ты запалился

я и думаю что-то знаком он мне

Пробовал UpdateWindow, RedrawWindow, BeginPaint... Нифига не работает.

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

 

[Avangard]

DaRKdemoN, типа WM_PAINT?

 

[Shegorat]

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

Так как-раз таки и нужно перекрывать функцию рисования самого окна, чтобы нарисовать свою картинку. Точнее нужно перекрыть оконную процедуру и уже в ней при сообщении WM_PAINT рисовать все что нужно.
P.S. Для выяснения отношений есть ЛС.

 

[Avangard]

Shegorat, а можно пример? :-[

Shegorat
DaRKdemoN
А перекрывать оконную процедуру нужно через функцию WindowProc?

 

[DaRKdemoN]

MasteR
SetWindowLong(handle,GWL_WNDPROC,указатель на новую процедуру обработки сообщений).
из справки:
If the function succeeds, the return value is the previous value of the specified 32-bit integer(т.е. LongInt).
получается так - записываешь в переменную адрес старой wndproc, в новой при сообщении WM_PAINT рисуешь что надо, ну и наконец вызываешь старый обработчик через CallWindowProc с указанием старого wndproc.

Добавлено через 18 минут
вот если не понял ClickMe, почитай - думаю поймёшь, там всё оч. просто.

P.S. гуглить надо, я эту ссыль нашёл за ~1 мин.

 

[Avangard]

DaRKdemoN, ничего не получается. Изображения все равно не грузится.

Спойлер: Исходник

library isLogo;

uses
Windows, Messages, GDIPAPI, GDIPOBJ, GDIPUTIL;

{$R *.res}

var
img: TGPImage;
graph: TGPGraphics;
graphp: Pointer;
p: TGPRectF;
imgHandle: THandle;
Msg: Cardinal;
WParam, LParam: Integer;

Function ImgWinProc(): Cardinal; Stdcall;

Begin
Result := CallWindowProc(Pointer(GetWindowLong(imgHandle, GWL_USERDATA)),

imgHandle, Msg, WParam, LParam);

End;

procedure create_logo(wnd: HWND; FileName: PChar; X, Y, W, H: Integer) stdcall;
begin
SetWindowLong(imgHandle, GWL_WNDPROC, LongInt(@ImgWinProc));

case Msg Of
WM_PAINT:
Begin

img := TGPImage.Create(filename);

p.X:=x;
p.Y:=y;
p.Width:=w;
p.Height:=h;

graph := TGPGraphics.Create(getdc(wnd));
graph.DrawImage(img, p);
End;
End;
CallWindowProc(Pointer(GetWindowLong(Wnd, GWL_USERDATA)), Wnd, Msg, WParam, LParam);
UpdateWindow(wnd);
end;

procedure Free(); stdcall;
begin
img.Free;
graph.Free;
GdiplusShutdown(1);
end;

exports create_logo;
exports free;

begin
end.

 

[LexBell]

dvd4el, Эээ, чегото тебя совсем не туда, куда-то понесло
В этом посте
function MyProc(h: HWND; Msg, wParam, lParam: longint): Longint; - и есть процедура обработки оконных сообщений.
OldProc:= SetWindowLong(WizardForm.Handle, GWL_WNDPROC, WndProcCallBack(@MyProc, 4)); - это указание хендлу, что он должен использовать эту процедуру, для обработки поступающих сообщений.
SetWindowlong(WizardForm.Handle, GWL_WNDPROC, OldProc); - эта строчка освобождает созданную оконную процедуру, возвращая родную. В дельфи, для этого, не нужно подключать Каллбэк, она и так знает, чего это такое