Code source pour développer une application, page 23
Un sujet vous tient à coeur ou un code source à partager ? Le site est ouvert à tous, n'hesitez pas à publier sur Fobec.com
Code source informatique
Lire/enregistrer un ensemble de propriétés par exemple TFontStyles
type pFontStyles = ^TFontStyles; pInteger = ^Integer; function FontStylesToInteger ( const Value : TFontStyles) : Integer; begin Result := pInteger(@Value)^; end; function ...
Obtenir les bibliothèques de type installées
uses Registry; procedure EnumTypeLibs(TypeLibNames: TStrings); var f: TRegistry; keyNames, keyVersions, keyInfos: TStringList; keyName, keyVersion, keyInfo, tlName: string; i, j, k: Integer;...
Obtenir la liste des raccourcis ainsi que de l'application associée
uses Registry; procedure TForm1.Button1Click(Sender: TObject); var reg: TRegistry; keys: TStringList; i: Integer; typename, displayname, server: string; begin memo1.Clear; reg :=...
Obtenir un nom de fichier temporaire
function GetTempFile( const Extension: string): string; var Buffer: array[0..MAX_PATH] OF Char; aFile : string; begin GetTempPath(Sizeof(Buffer)-1,Buffer); ...
Savoir lorsqu'un TForm passe à wsMaximized ou wsMinimized
private procedure WMSysCommand( var Msg: TWMSysCommand);message WM_SYSCOMMAND;{...}implementation{...} procedure TForm1.WMSysCommand( var Msg: TWMSysCommand); begin if (Msg.CmdType =...
Vider le buffer du clavier/de la souris
procedure EmptyKeyQueue; var Msg: TMsg; begin while PeekMessage(Msg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE or PM_NOYIELD) do; end; procedure EmptyMouseQueue; var Msg: TMsg; begin while...
Ajouter les evenements MouseEnter & MouseLeave sur vos composants
unit ImageEx;interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;type TImageEx = class (TImage) private { Private declarations } ...
Afficher un TForm plus petit que 112 pixels
unit Unit1;interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;type TForm1 = class(TForm) procedure FormCreate(Sender: TObject);private procedure ...
Utiliser les fonctions du Shell (Windows) pour la copie
uses Shellapi; TSHFileOpStructA = record Wnd:HWnd; wFunc:Uint; pFrom:PAnsiChar; pTo:PAnsiChar; fFlags:FILEOP_FLAGS; fAnyOperatiosAborted:Bool; hNameMappings:Pointer; ...
Effectuer une rotation de n'importe quel angle sur un Bitmap
const PixelMax = 32768;type pPixelArray = ^TPixelArray; TPixelArray = Array[0..PixelMax-1] Of TRGBTriple; procedure RotateBitmap_ads( SourceBitmap : TBitmap; out DestBitmap : TBitmap; ...
Crypter un fichier ou un string
unit EZCrypt;{modeled by Ben Hochstrasser(bhoc@surfeu.ch) after some code snippet from borland)interface uses Windows, Classes;type TWordTriple = Array[0..2] of Word; function FileEncrypt(InFile,...
Crypter un String
unit uEncrypt;interface function Decrypt( const S: AnsiString; Key: Word): AnsiString; function Encrypt( const S: AnsiString; Key: Word): AnsiString;implementation const C1 = 52845; C2 =...
Rechercher et marquer du texte dans un TWebBrowser
private procedure SearchAndHighlightText(aText: string); {....} procedure TForm1.SearchAndHighlightText(aText: string); var i: Integer; begin for i := 0 to...
Vérifier la validité d'une adresseIP
function iswrongip(ip: string): boolean; var z, i: byte; st: array[1..3] of byte; const z if f = ['0'..'9']; begin st[1] := 0; st[2] := 0; st[3] := 0; z := 0; ...
Concevoir un petit chronomètre
var Form1: TForm1; TheTime:Integer;implementation{$R *.DFM}Function GetCounter(Second:Integer):String;Var Minute,NewSecond,Hour : Currency;Begin Hour := Int(Second / 3600); Minute :=...
Connaitre la police du menu system
function GetMenuFont: TFont; var ncm: TNonClientMetrics; begin ncm.cbSize := SizeOf(TNonClientMetrics); SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(TNonClientMetrics), @ncm, 0); ...
Etablir une connection ADO en utilisant OLE
uses ComObj;{$R *.DFM} function OpenConnection(ConnectionString:AnsiString):Integer; var ADODBConnection : OleVariant; begin ADODBConnection :=...
Convertir une image au format bmp vers un emf (Enhanced Metafile)
function bmp2emf( const SourceFileName: TFileName): Boolean;// Converts a Bitmap to a Enhanced Metafile (*.emf) var Metafile: TMetafile; MetaCanvas: TMetafileCanvas; Bitmap: TBitmap; begin ...