500+ FAQ по Delphi

Перейти на: Главную | Индексную | Предыдущую | Следующую страницу
Champ Elma Kadloo luxe wood шкатулки для автоподзавода часов бесплатная доставка.

Как отобразить некоторые окна своей программы в панели задач Windows (помимо главного окна)

Hапример, так:

procedure TMyForm.CreateParams(var Params :TCreateParams); {override;}
begin
inherited CreateParams(Params); {CreateWindowEx}
Params.ExStyle := Params.ExStyle or WS_Ex_AppWindow;
end;

Как изменить цвет отмеченных записей в DBGrid?

Hапример, так:
DefaultDrawing:=False;
....
procedure TfrmCard.GridDrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn;
State: TGridDrawState);
var
Index : Integer;
Marked,
Selected: Boolean;
begin

Marked := False;
if (dgMultiSelect in Grid.Options) and THackDBGrid(Grid).Datalink.Active then
Marked
:=Grid.SelectedRows.Find(THackDBGrid(Grid).Datalink.Datasource.Dataset.Bookmark
, Index);

Selected := THackDBGrid(Grid).Datalink.Active and (Grid.Row-1 =
THackDBGrid(Grid).Datalink.ActiveRecord);

if Marked then begin
Grid.Canvas.Brush.Color:=$DFEFDF;;
Grid.Canvas.Font.Color :=clBlack;
end;

if Selected then begin
Grid.Canvas.Brush.Color:=$FFFBF0;
Grid.Canvas.Font.Color :=clBlack;
if Marked then
Grid.Canvas.Brush.Color:=$EFE3DF; { $8F8A30 }
end;

Grid.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;

где

THackDBGrid = class(TDBGrid)
property DataLink;
property UpdateLock;
end;

Как вставить в StatusPanel свои компоненты, например ProgressBar?

pgProgress положить на форму как Visible := false;
StatusPanel надо OwnerDraw сделать и pефpешить, если Position меняется.

procedure TMainForm.stStatusBarDrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
if Panel.Index = pnProgress then
begin
pgProgress.BoundsRect := Rect;
pgProgress.PaintTo(stStatusBar.Canvas.Handle, Rect.Left, Rect.Top);
end;
end;

Как отчитывать промежутки времени с точностью, большей чем 60 мсек?

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

procedure FNTimeCallBack(uTimerID, uMessage: UINT;dwUser, dw1, dw2: DWORD)
stdcall;
begin
//
// Тело процедуры.
end;

а дальше в программе (например по нажатию кнопки) создаешь Таймер и вешаешь
на него созданную процедуру

uTimerID:=timeSetEvent(10,500,@FNTimeCallBack,100,TIME_PERIODIC);

Подробности смотри в Help.
Hу и в конце убиваешь таймер

timeKillEvent(uTimerID);

И все. Точность этого способа до 1 мсек. минимальный интервал времени можно задавать 1 мсек.

Как вставить в нужное место Rich Text в Rich Text Control?

Вы можете послать сообщение EM_STREAMIN с параметром SFF_SELECTION
методом Perform для замены текущего Selection. Выдержка из Help:

EM_STREAMIN
wParam = (WPARAM) (UINT) uFormat; // Integer
lParam = (LPARAM) (EDITSTREAM FAR *) lpStream; // EDITSTREAM^

The EM_STREAMIN message replaces the contents of a rich edit control with the
specified data stream.

Parameters

uFormat

One of the following data formats, optionally combined with the SFF_SELECTION
flag:

Value Meaning
SF_TEXT Text
SF_RTF Rich-text format
If the SFF_SELECTION flag is specified, the stream replaces the contents of the
current selection. Otherwise, the stream replaces the entire contents of the
control.

lpStream

Pointer to an EDITSTREAM structure. The control reads (streams in) the data by
repeatedly calling the function specified by the structure's pfnCallback
member.

Return Value

Returns the number of characters read.

Как указать максимальный размер текста для RichEdit Control?

У этого компонента есть свойство MaxLength, которое работает некорректно.
Поэтому лучше пользоваться RichEdit.Perform(EM_LIMITTEXT, нужный размер, 0);
Причем перед каждом открытии файла это действие необходимо повторять.

Если Вы передаете в качестве размера 0, то ОС ограничивает размер
OS Specific Default Value. Реально, по результатам моих экспериментов,
поставить можно размер, чуть меньший доступной виртуальной памяти.
Я ограничился 90% от свободной виртуалки.

Для того, чтобы не повторять этот вызов (EM_LIMITTEXT), можно воспользоваться
сообщением EM_EXLIMITTEXT.

Как инсталлировать на время работы программы свои шрифты?

Добавить фонт (.fon, .fot, .fnt, .ttf) в систему можно след. образом:

{$IFDEF WIN32}
AddFontResource( PChar( my_font_PathName { AnsiString } ) );
{$ELSE}
var
ss : array [ 0..255 ] of Char;

AddFontResource ( StrPCopy ( ss, my_font_PathName ));
{$ENDIF}
SendMessage ( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );

Убрать его по окончании работы:

{$IFDEF WIN32}
RemoveFontResource ( PChar(my_font_PathName) );
{$ELSE}
RemoveFontResource ( StrPCopy ( ss, my_font_PathName ));
{$ENDIF}
SendMessage ( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );

При этом не надо никаких перезагрузок и прочего, после добавления фонт сразу
можно использовать. my_font_PathName : string ( не string[nn] для D2+) -
содержит полный путь с именем и расширением необходимого фонта.
После удаления фонта форточки о нем забывают.
Если его не удалить, он (кажется) так и останется проинсталенным, во всяком
случае, я это не проверял.

Как научить Delphi делать правильное округление дробных чисел?

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

// во врезке - кодировка win1251

Function RoundStr(Zn:Real;kol_zn:Integer):Real;
{Zn-чэрўхэшх; Kol_Zn-¦юы-тю чэръют яюёых чря Єющ}
Var snl,s,s0,s1,s2:String; n,n1:Real; nn,i:Integer;
begin
s:=FloatToStr(Zn);
if (Pos(',',s)>0) and (Zn>0) and
(Length(Copy(s,Pos(',',s)+1,length(s)))>kol_zn)
then begin
s0:=Copy(s,1,Pos(',',s)+kol_zn-1);
s1:=Copy(s,1,Pos(',',s)+kol_zn+2);
s2:=Copy(s1,Pos(',',s1)+kol_zn,Length(s1));
n:=StrToInt(s2)/100; nn:=Round(n);
if nn>=10 then begin
snl:='0,'; For i:=1 to kol_zn-1 do snl:=snl+'0'; snl:=snl+'1';
n1:=StrToFloat(Copy(s,1,Pos(',',s)+kol_zn))+StrToFloat(snl);
s:=FloatToStr(n1); if Pos(',',s)>0 then s1:=Copy(s,1,Pos(',',s)+kol_zn);
end else s1:=s0+IntToStr(nn);
if s1[Length(s1)]=',' then s1:=s1+'0';
Result:=StrToFloat(s1);
end else Result:=Zn;
end;

Все-таки работа со строками здесь излишество -

function RoundEx( X: Double; Precision : Integer ): Double;
{Precision :
1 - до целых
10 - до десятых
100 - до сотых
...
}
var ScaledFractPart, Temp : Double;
begin
ScaledFractPart := Frac(X)*Precision;
Temp := Frac(ScaledFractPart);
ScaledFractPart := Int(ScaledFractPart);
if Temp >= 0.5 then ScaledFractPart := ScaledFractPart + 1;
if Temp <= -0.5 then ScaledFractPart := ScaledFractPart - 1;
RoundEx := Int(X) + ScaledFractPart/Precision;
end;

Мне нужно откpыть из моей фоpмы модальное окно, т.е. пpиостановить pаботу в моей фоpме до обpаботки этого модального окна. Hо пpи этом я теpяю возможность убpать (минимизиpовать) мою фоpму.

function TMyForm.Execute: TModalResult;
begin
Show;
try
SendMessage(Handle, CM_ACTIVATE, 0, 0);
ModalResult := 0;
repeat
Application.HandleMessage;
if Application.Terminated then ModalResult := mrCancel;
if ModalResult = mrCancel then CloseModal;
until ModalResult <> 0;
Hide;
Result := ModalResult;
SendMessage(Handle, CM_DEACTIVATE, 0, 0);
finally
Hide;
end;
end;

Конечно, в TMyForm должно быть FormStyle := fsStayOnTop;

Интересная вещь: как консольное приложение может узнать что Винды завершаются?

Все процессы получают сигналы CTRL_CLOSE_EVENT, CTRL_LOGOFF_EVENT и
CTRL_SHUTDOWN_EVENT. А делается это (грубо говоря :) так:

BOOL Ctrl_Handler( DWORD Ctrl )
{
if( (Ctrl == CTRL_SHUTDOWN_EVENT)
|| (Ctrl == CTRL_LOGOFF_EVENT)
)
{
// Вау! Юзер обламывает!
}
else
{
// Тут что-от другое можно творить. А можно и не творить :-)
}
return TRUE;
}

function Ctrl_Handler(Ctrl: Longint): LongBool;
begin
if Ctrl in [CTRL_SHUTDOWN_EVENT, CTRL_LOGOFF_EVENT] then
begin
// Вау, вау
end
else
begin
// Am I creator?
end;
Result := true;
end;

А где-то в программе:

SetConsoleCtrlHandler( Ctrl_Handler, TRUE );

Таких обработчиков можно навесить кучу. Если при обработке какого-то из
сообщений обработчик возвращет FALSE, то вызывается следующий обработчик. Можно
насторить таких этажерок, что ого-го :-)))

Короче, смотри описание SetConsoleCtrlHandler -- там всё есть.

Как работать с поименованными каналами под W'95/NT в сети?

сервер :
StrPCopy(buff,Edit1.Text);
fPipeHandle:=CreateNamedPipe(buff,
Pipe_Access_Duplex or File_Flag_Overlapped,
Pipe_Type_Message or Pipe_ReadMode_Byte or Pipe_Wait,
5, $400, $400, 235, nil);

клиент :
StrPCopy(buff,Edit1.Text);
fFileHandle:=CreateFile(buff,
Generic_Read or Generic_Write,
File_Share_Read or File_Share_Write,
nil,
Open_Existing,
File_Attribute_Normal or File_Flag_Overlapped or Security_Anonymous,
0);
if fFileHandle <> Invalid_Handle_Value then begin ...

Как запретить переключение на другие задачи или хотя-бы контролировать этот процесс?


Выключить Ctl-alt-del

bool old;
SystemParametersInfo (SPI_SCREENSAVERRUNNING,1,&old,0)

Включить обратно
SystemparametersInfo (SPI_ScreenSaverrunning,0,&old,0)


Мне помогло. Хоть и пpишлось повозиться: в хэлпе нет пpо паpаметp
SPI_SCREENSAVERRUNNING...

Как рисовать картинки в пунктах меню (через OwnerDraw)?

unit DN_Win;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Menus, StdCtrls,

type
TDNForm = class(TForm)
MainMenu1: TMainMenu;
cm_MainExit: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure cm_MainExitClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
BM:TBitmap;
Procedure WMDrawItem(var Msg:TWMDrawItem); message wm_DrawItem;
Procedure WMMeasureItem(var Msg:TWMMeasureItem); message
wm_MeasureItem;

end;

var
DNForm : TDNForm;

implementation

{$R *.DFM}

var
Comm,yMenu : word;

procedure TDNForm.FormCreate(Sender: TObject);
begin
{ърЁЄшэъє т ьхэ¦}
yMenu:=GetSystemMetrics(SM_CYMENU);
comm:=cm_MainExit.Command;
ModifyMenu(MainMenu1.Handle,0,mf_ByPosition or mf_OwnerDraw,comm,'Go');
end;{TDNForm.FormCreate}

procedure TDNForm.cm_MainExitClick(Sender: TObject);
begin
DNForm.Close;
end;{TDNForm.cmExitClick}

{фы  яЁюЁшёютъш ьхэ¦}
Procedure TDNForm.WMMeasureItem(var Msg:TWMMeasureItem);
Begin
with Msg.MeasureItemStruct^ do
if ItemID=comm then begin ItemWidth:=yMenu; Itemheight:=yMenu; end;
End;{WMMeasureItem}
{}
Procedure TDNForm.WMDrawItem(var Msg:TWMDrawItem);
var
MemDC:hDC;
BM:hBitMap;
mtd:longint;
Begin
with Msg.DrawItemStruct^ do
begin
if ItemID=comm then
begin
BM:=LoadBitMap(hInstance,'dver');
MemDC:=CreateCompatibleDC(hDC);{hDC тїюфшЄ т ёЄЁєъЄєЁє
TDrawItemStruct}
SelectObject(MemDC,BM);
{rcItem тїюфшЄ т ёЄЁєъЄєЁє TDrawItemStruct}
if ItemState=ods_Selected then mtd:=NotSrcCopy else mtd:=SrcCopy;

StretchBlt(hDC,rcItem.left,rcItem.top,yMenu,yMenu,MemDC,0,0,24,23,mtd);
DeleteDC(MemDC);
DeleteObject(BM);
end;
end{with}
End;{TDNForm.WMDrawItem}

end.


Материалы находятся на сайте http://cracklab.narod.ru/faq/


Создатель этого HTML файла не претендует на авторство вопросов/ответов представленных в нём, не отвечает за их содержание и достоверность, а также за последствия использования программных кодов , полученных из этого HTML файла. Также не принимаются претензии относительно не размещённой информации об авторе каждого конкретного FAQ'а. Любые другие вопросы присылайте на bad_guy@cracklab.ru (обращаться к Bad_guy'ю).
Hosted by uCoz