Implement an animated gradient

January 17, 2020 0

(* —————————————————————- I have taken two tipps from this site to work together: 1. to draw a gradient from David Johannes Rieger 2. the unit anithread form P. Below what’s coming out is a animated […]

Show the mainform as a dialog with a mainmenu

January 17, 2020 0

Show the mainform as a dialog with a mainmenu ———————————————————————- If you want to show your mainform as a dialog (setting BorderStyle := bsDialog) and don’t want to miss your main menu… ———————————————————————- procedure TMain.FormCreate(Sender: […]

Highlight Text with TMemo

January 17, 2020 0

Highlight with TMemo Impossible? try this… by Gon Perez-Jimenez May’04 This is a sample how to work with highlighting within TMemo component by using interjected class technique. Of course, this code is still uncompleted but […]

Prevent mouvement of a form outside the desktop

January 17, 2020 0

Prevent mouvement of a form outside the desktop procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Form1.Left = Screen.Height – Form1.Height then Form1.Top := Screen.Height – Form1.Height; end;

Save and Load Font from a configuration file

January 17, 2020 0

Save and Load Font from a configuration file unit DelphiCenterU1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IniFiles; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; ListBox1: TListBox; FontDialog1: TFontDialog; […]

Change the color of a TToolButton

January 17, 2020 0

Change the color of a TToolButton procedure TForm1.ToolBar1CustomDrawButton(Sender: TToolBar; Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean); begin // select color Sender.Canvas.Brush.Color := clAqua; // Paint selected color Sender.Canvas.Rectangle(Button.BoundsRect); end;

Minimze the application visually to the tray (TNA)

January 17, 2020 0

Minimze the application visually to the tray (TNA) function MinimizeToTray(Handle: HWND): Boolean; var hwndTray: HWND; rcWindow: TRect; rcTray: TRect; begin // Check passed window handle if IsWindow(Handle) then begin // Get tray handle hwndTray := […]

Synchronize two RichEdit by scrolling

January 17, 2020 0

Synchronize two RichEdit by scrolling //… private PRichEdWndProc, POldWndProc: Pointer; procedure RichEdWndProc(var Msg: TMessage); //… procedure TForm1.FormCreate(Sender: TObject); begin PRichEdWndProc := MakeObjectInstance(RichEdWndProc); POldWndProc := Pointer(SetWindowLong(RichEdit1.Handle, GWL_WNDPROC, Integer(PRichEdWndProc))); end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin […]

Show an Editibox linked Balloontip

January 17, 2020 0

Windows +XP Form witch one button and one editbox type tagEDITBALLOONTIP = record cbStruct: Longword; pszTitle: PWChar; pszText: PWChar; ttiIcon: Integer; end; type PEDITBALLOONTIP = ^tagEDITBALLOONTIP; const ECM_FIRST = $00001500; EM_SHOWBALLOONTIP = ECM_FIRST + 3; […]

Easily move/resize components at runtime

January 17, 2020 0

———————————————————————- This Tip provides a tool class that implements the functionality of moving or resizing any component at runtime (as in the IDE) ———————————————————————- Als eigne Unit unit Egal; interface uses Controls, ExtCtrls, QGraphics, Classes, […]

Allow to move form only within working area

January 17, 2020 0

Allow to move form only within working area { …. } type TForm1 = class(TForm) private protected procedure WMMoving(var Message: TWMMoving); message WM_MOVING; public end; { …. } procedure TForm1.WMMoving(var Message: TWMMoving); var rec: ^TRect; […]

Show a form without focusing

January 17, 2020 0

Show a form without focusing in TCustomForm class,in protected section add procedure ShowParam(var param : integer);dynamic; { this procedure call when form should be show, now you should override this method and write your option […]

Get and set mouse position

January 17, 2020 0

Get mouse positon procedure TForm1.Button1Click(Sender: TObject); var MausPos: TPoint; begin GetCursorPos(MausPos); label1.Caption := IntToStr(MausPos.x); label2.Caption := IntToStr(MausPos.y); end; Set mouse position to (x,y) procedure TForm1.Button2Click(Sender: TObject); begin SetCursorPos(600, 600); end;

Open a form animated

January 17, 2020 0

Open a form animated procedure TForm1.Button1Click(Sender: TObject); procedure Delay(msec: Longint); var start, stop: Longint; begin start := GetTickCount; repeat stop := GetTickCount; Application.ProcessMessages; until (stop – start) >= msec; end; var maxx, maxy: Integer; begin […]

Use system icons

January 17, 2020 0

Use system icons possible constants: – IDI_APPLICATION – IDI_ASTERISK – IDI_EXCLAMATION – IDI_HAND – IDI_QUESTION //Icons procedure TForm1.Button1Click(Sender: TObject); var icon: TIcon; begin icon := TIcon.Create; try icon.Handle := LoadIcon(0, IDI_HAND); Canvas.Draw(30, 100, icon); finally […]

Make a desktop screenshot

January 17, 2020 0

Make a desktop screenshot {———————1———————} function GetScreenShot: TBitmap; var Desktop: HDC; begin Result := TBitmap.Create; Desktop := GetDC(0); try try Result.PixelFormat := pf32bit; Result.Width := Screen.Width; Result.Height := Screen.Height; BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, […]

Show a popupmenu in the task notification area

January 17, 2020 0

Show a popupmenu in the task notification area unit TNA; interface uses Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls, ShellApi, Menus; const k_WM_TASKMSG = WM_APP + 100; //die “100” ist ein frei wنhlbarer Wert type […]

Make a form’s caption scrolling

January 17, 2020 0

Make a form’s caption scrolling var a: string; procedure TForm1.FormCreate(Sender: TObject); begin a := ‘Look at here !…’; end; procedure TForm1.Timer1Timer(Sender: TObject); var i: Integer; begin Application.Title := a; Form1.Caption := a; for i := […]

Prevent a Form from Moving/Resizing

January 17, 2020 0

procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND; {…} implementation procedure TForm1.WMSysCommand(var Msg: TWMSysCommand); begin if ((Msg.CmdType and $FFF0) = SC_MOVE) or ((Msg.CmdType and $FFF0) = SC_SIZE) then begin Msg.Result := 0; Exit; end; inherited; end;

Find classes registered by a form class

January 17, 2020 0

Find classes registered by a form class 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 […]

Capture the screen

January 17, 2020 0

Capture the screen uses Graphics; // Capture the entire screen procedure ScreenShot(Bild: TBitMap); var c: TCanvas; r: TRect; begin c := TCanvas.Create; c.Handle := GetWindowDC(GetDesktopWindow); try r := Rect(0, 0, Screen.Width, Screen.Height); Bild.Width := Screen.Width; […]

Make a form transparent

January 17, 2020 0

Suppose you have one form named Form1, and a button1 on Form1, On Form1’s OnCreate event write these code: procedure TForm1.FormCreate(Sender: TObject); begin SetWindowLong(Form1.Handle, GWL_EXSTYLE, (GetWindowLong(Form1.Handle, GWL_EXSTYLE) or WS_WX_TRANSPARENT)); end;

Adjust the Windowform to a TCanvas

January 17, 2020 0

When you need a form like a tree or something else what do you do? Windows provides the CreateRoundRectRegion() function that just cuts the edges of your form. If you want to do something else, […]

Trap the Main forms WM_MOVE message

January 17, 2020 0

Trap the Main forms WM_MOVE message type TForm1 = class(TForm) private procedure WMMove(var Msg: TWMMove); message WM_MOVE; { Private-Deklarationen} public { Public-Deklarationen} end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.WMMove(var Msg: TWMMove); begin inherited; […]

Hide the caption bar

January 17, 2020 0

Hide the caption bar procedure TForm1.HideTitlebar; var Style: Longint; begin if BorderStyle = bsNone then Exit; Style := GetWindowLong(Handle, GWL_STYLE); if (Style and WS_CAPTION) = WS_CAPTION then begin case BorderStyle of bsSingle, bsSizeable: SetWindowLong(Handle, GWL_STYLE, […]

Position a messagebox over a form

January 17, 2020 0

Position a messagebox over a form const mbMessage = WM_USER + 1024; type private procedure ChangeMessageBoxPosition(var Msg: TMessage); message mbMessage; end; var Form1: TForm1; msgCaption: PChar; // variable to hold the caption implementation {$R *.DFM} […]

Show a TMenuItem right-aligned

January 17, 2020 0

Show a TMenuItem right-aligned Shows all Menu items from the MenuIndex on right-aligned. procedure TForm1.FormCreate(Sender: TObject); const MenuIndex = 3; var MII: TMenuItemInfo; MainMenu: hMenu; Buffer: array[0..50] of Char; begin MainMenu := GetMenu(Handle); with MII […]

Get a Popup Menu Items Parent

January 17, 2020 0

Get a Popup Menu Items Parent procedure TForm1.PopupMenu1Popup(Sender: TObject); begin Label1.Caption := PopupMenu1.PopupComponent.Name; end;

Move your form by clicking anywhere

January 17, 2020 0

Move your form by clicking anywhere private procedure WMNCHitTest(var msg: TWMNCHitTest); message WM_NCHITTEST; end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.WMNCHitTest(var msg: TWMNCHitTest); begin inherited; if msg.Result = htClient then msg.Result := htCaption; end; […]

Show Window Contents while dragging

January 17, 2020 0

Show Window Contents while dragging procedure ShowContents(Value: Boolean); begin SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, Ord(Value), nil, 0); end; // To Show window contents while dragging: procedure TForm1.Button1Click(Sender: TObject); begin ShowContents(True); end; // To disable this option call the function: […]

Draw a gradient fill on a form

January 17, 2020 0

Draw a gradient fill on a form procedure FillGradientRect(Canvas: TCanvas; Recty: TRect; fbcolor, fecolor: TColor; fcolors: Integer); var i, j, h, w, fcolor: Integer; R, G, B: Longword; beginRGBvalue, RGBdifference: array[0..2] of Longword; begin beginRGBvalue[0] […]

Add Menu Items to the System Menu

January 17, 2020 0

Add Menu Items to the System Menu private procedure WMSysCommand(var Msg: TMessage); message WM_SYSCOMMAND; {…} const ID_ABOUT = WM_USER + 1; ID_HELP = WM_USER + 2; ID_NEWLINE = WM_USER + 4; {…} implementation {…} procedure […]

Remove items from the System Menu

January 17, 2020 0

Remove items from the System Menu private procedure WMInitMenuPopup(var Msg: TWMInitMenuPopup); message WM_INITMENUPOPUP; {…} implementation {…} procedure TForm1.WMInitMenuPopup(var Msg: TWMInitMenuPopup); begin inherited; if Msg.SystemMenu then begin DeleteMenu(Msg.MenuPopUp, SC_SIZE, MF_BYCOMMAND); DeleteMenu(Msg.MenuPopUp, SC_MAXIMIZE, MF_BYCOMMAND); DeleteMenu(Msg.MenuPopUp, SC_MINIMIZE, MF_BYCOMMAND); […]

Move components at Runtime

January 17, 2020 0

Move components at Runtime This example shows how to move components at runtime, dragging it. You are able to see the components move as you drag them. Attach the Control event handlers (ControlMouseDown,…) to all […]

1 2 3 6