Общие вопросы

Как бы это осуществить рисование в окне без его дурацкого мерцания и без помощи создания виртуального изображения в памяти? WM_SETREDRAW здесь поможет?

 

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

Подробнее: Мерцание формы Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Общие вопросы TForm

Как сделать так, чтобы окно было неактивно? Вы скажите: "Ничего сложного. Нужно только свойство окна Enabled установить в false"... но, так как окно является владельцем компонентов, находящихся на нём, то и все компоненты станут неактивными! Но был найден способ избежать этого!

Code:

private

{ Private declarations }

procedure WMNCHitTest (var M: TWMNCHitTest); message wm_NCHitTest;

 

implementation

{$R *.DFM}

 

procedure TForm1.WMNCHitTest (var M:TWMNCHitTest);

begin

if M.Result = htClient then

   M.Result := htCaption;

end;

 

 

Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Общие вопросы TForm

 

Иногда бывает нужно сложить два или более цветов для получения что-то типа переходного цвета. Делается это весьма просто. Координаты получаемого цвета будут равны среднему значению соответствующих координат всех цветов.

 

Например, нужно сложить красный и синий. Получаем

 

(255,0,0)+(0,0,255)=((255+0) div 2,(0+0) div 2,(0+255) div 2)=(127,0,127).

 

В результате получаем сиреневый цвет. Также надо поступать, если цветов более чем 2: сложить соответствующие координаты, потом каждую сумму разделить нацело на количество цветов.

 

Поговорим теперь о градиентной заливке. Градиентная заливка - это заливка цветом с плавным переходом от одного цвета к другому.

 

Итак, пусть заданы 2 цвета своими координатами ((A1, A2, A3) и (B1, B2, B3)) и линия (длиной h пикселов), по которой нужно залить. Тогда каждый цвет каждого пиксела, находящегося на расстоянии x пикселов от начала будет равен (A1-(A1-B1)/h*x, A2-(A2-B2)/h*x, A3-(A3-B3)/h*x). Теперь, имея линию с градиентной заливкой, можно таким образом залить совершенно любую фигуру: будь то прямоугольник, круг или просто произвольная фигура.

 

Подробнее: Пример градиентной... Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Общие вопросы TForm

 

Code:

function SetFullscreenMode: Boolean;

var

DeviceMode: TDevMode;

begin

with DeviceMode do

begin

   dmSize := SizeOf(DeviceMode);

   dmBitsPerPel := 16;

   dmPelsWidth := 640;

   dmPelsHeight := 480;

   dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;

   result := False;

   if ChangeDisplaySettings(DeviceMode, CDS_TEST or CDS_FULLSCREEN) <>

     DISP_CHANGE_SUCCESSFUL then

     Exit;

   Result := ChangeDisplaySettings(DeviceMode, CDS_FULLSCREEN) =

     DISP_CHANGE_SUCCESSFUL;

end;

end;

 

procedure RestoreDefaultMode;

var

T: TDevMode absolute 0;

begin

ChangeDisplaySettings(T, CDS_FULLSCREEN);

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

if setFullScreenMode then

begin

   sleep(7000);

   RestoreDefaultMode;

end;

end;

 

 

Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Общие вопросы TForm

 

Code:

type

  PFieldClassTable = ^TFieldClassTable;

  TFieldClassTable = packed record

    Count: Smallint;

    Classes: array[0..8191] of ^TPersistentClass;

  end;

 

function GetFieldClassTable(AClass: TClass): PFieldClassTable; assembler;

asm

        MOV     EAX,[EAX].vmtFieldTable

        OR      EAX,EAX

        JE      @@1

        MOV     EAX,[EAX+2].Integer

@@1:

end;

 

procedure TForm1.Button1Click(Sender: TObject);

  procedure Display( const S: String );

  begin

    memo1.lines.add( S );

  end;

var

  pFCT: PFieldClassTable;

  aClass: TClass;

  i: SmallInt;

begin

  memo1.clear;

  aClass:= Classtype;

  While aClass <> TPersistent Do Begin

    Display('Registered classes for class '+aClass.Classname );

    pFCT := GetFieldClasstable( aClass );

    If not Assigned( pFCT ) Then

      Display('  No classes registered')

    Else Begin

      Display( format('  %d classes registered', [pFCT^.Count]));

      for i:= 0 to pFCT^.Count -1 do

        Display( '  '+pFCT^.Classes[i]^.ClassName );

    End;

    aClass := aClass.ClassParent;

  End

end;

 

 

Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Общие вопросы TForm

Часто возникает проблема - в многооконном приложении необходимо обратить внимание пользователя на то, что какое-то из окон требует внимания (например, к нему пришло сообщение по DDE, в нем завершился какой-либо процесс, произошла ошибка ...). Это легко сделать, используя команду API FlashWindow:

Code:

procedure TForm1.Timer1Timer(Sender: TObject);

begin

FlashWindow(Handle,true);

end;

 

Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Общие вопросы TForm

Функция, которая нарисует на форме сетку и сделает форму похожей на дизайнер форм Delphi. По умолчанию в дизайнере Delphi отступы равны 8 пикселям

 

Code:

Procedure TForm1.DrawGrid;

Var

TmpBmp: TBitmap;

Begin

TmpBmp := TBitmap.Create;

Try

   With TmpBmp Do

   Begin

     Width := 8;

     Height := 8;

     Canvas.Brush.Color := clBtnFace;

     Canvas.FillRect(TmpBmp.Canvas.ClipRect);

     Canvas.Pixels[0, 0] := clBlack;

     Canvas.Pixels[0, Height] := clBlack;

     Canvas.Pixels[Width, 0] := clBlack;

     Canvas.Pixels[Width, Height] := clBlack;

   End;

   With Canvas, Brush Do

   Begin

     Bitmap := TBitmap.Create;

     Try

       Bitmap.Assign(TmpBmp);

       Canvas.FillRect(Canvas.ClipRect);

     Finally

       Bitmap.Free;

     End;

   End;

Finally

   TmpBmp.Free;

End;

End;

 

{ Использование }

Procedure TForm1.FormPaint(Sender: TObject);

Begin

DrawGrid;

End;

 

Подробнее: Функция, которая... Добавить комментарий
Подробности
Родительская категория: TForm
Категория: Общие вопросы TForm