Delphi Snippets
Balloon Tipps anzeigen
procedure ShowBalloonTip(Control: TWinControl; Icon: integer; Title: pchar; Text: PWideChar); const TOOLTIPS_CLASS = 'tooltips_class32'; TTS_ALWAYSTIP = $01; TTS_NOPREFIX = $02; TTS_BALLOON = $40; TTF_SUBCLASS = $0010; TTF_TRANSPARENT = $0100; TTF_CENTERTIP = $0002; TTM_ADDTOOL = $0400 + 50; TTM_SETTITLE = (WM_USER + 32); ICC_WIN95_CLASSES = $000000FF; type TOOLINFO = packed record cbSize: Integer; uFlags: Integer; hwnd: THandle; uId: Integer; rect: TRect; hinst: THandle; lpszText: PWideChar; lParam: Integer; end; var hWndTip: THandle; ti: TOOLINFO; hWnd: THandle; begin hWnd := Control.Handle; hWndTip := CreateWindow(TOOLTIPS_CLASS, nil, WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP, 0, 0, 0, 0, hWnd, 0, HInstance, nil); if hWndTip <> 0 then begin SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE); ti.cbSize := SizeOf(ti); ti.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS; ti.hwnd := hWnd; ti.lpszText := Text; Windows.GetClientRect(hWnd, ti.rect); SendMessage(hWndTip, TTM_ADDTOOL, 1, Integer(@ti)); SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, Integer(Title)); end; end;
Dateinamen mit Zufallszahlen
function CheckCoverName(CoverName:string):string; var i: integer; begin //SysDir := ExtractFilePath(ParamStr(0)); if FileExists(SDir+'cover\'+CoverName) then begin i := splitscount(CoverName,'.'); randomize; result := SplitOutIndex(CoverName,'.',0)+ IntToStr(Random(99999)+1)+'.'+ SplitOutIndex(CoverName,'.',i-1); end else result := CoverName; end;
SQLite Wrapper
procedure TForm1.btnTestClick(Sender: TObject); var slDBpath: string; sldb: TSQLiteDatabase; sltb: TSQLIteTable; sSQL: String; Notes: String; begin slDBPath := ExtractFilepath(application.exename) + 'test.db'; sldb := TSQLiteDatabase.Create(slDBPath); try if sldb.TableExists('testTable') then begin sSQL := 'DROP TABLE testtable'; sldb.execsql(sSQL); end; sSQL := 'CREATE TABLE testtable ([ID] INTEGER PRIMARY KEY,[OtherID] INTEGER NULL,'; sSQL := sSQL + '[Name] VARCHAR (255),[Number] FLOAT, [notes] BLOB, [picture] BLOB COLLATE NOCASE);'; sldb.execsql(sSQL); sldb.execsql('CREATE INDEX TestTableName ON [testtable]([Name]);'); //begin a transaction sldb.BeginTransaction; sSQL := 'INSERT INTO testtable(Name,OtherID,Number,Notes) VALUES ("Some Name",4,587.6594,"Here are some notes");'; //do the insert sldb.ExecSQL(sSQL); sSQL := 'INSERT INTO testtable(Name,OtherID,Number,Notes) VALUES ("Another Name",12,4758.3265,"More notes");'; //do the insert sldb.ExecSQL(sSQL); //end the transaction sldb.Commit; //query the data sltb := slDb.GetTable('SELECT * FROM testtable'); try if sltb.Count > 0 then begin //display first row ebName.Text := sltb.FieldAsString(sltb.FieldIndex['Name']); ebID.Text := inttostr(sltb.FieldAsInteger(sltb.FieldIndex['ID'])); ebNumber.Text := floattostr( sltb.FieldAsDouble(sltb.FieldIndex['Number'])); Notes := sltb.FieldAsBlobText(sltb.FieldIndex['Notes']); memNotes.Text := notes; end; finally sltb.Free; end; finally sldb.Free; end; end;
Random Passwort Klasse
unit Password; interface type TPasswordMode = set of (pmUpper, pmLower, pmNumbers, pmExtra); TPassword = class private // FCharUpp, FCharLow, FChar09, FCharSy: boolean; // FpwLength, FpwCount: integer; public function GeneratePassword(ALength: Integer; Mode: TPasswordMode):String; end; implementation uses unit1; function TPassword.GeneratePassword(ALength: Integer; Mode: TPasswordMode):String; const cLower = 'abcdefghijklmnopqrstuvwxyz'; cUpper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'; cNumbers = '0123456789'; cExtra = '!§$&?€@~'; var i : Integer; S : String; iM: BYTE; begin // Kein mode angegeben, dann raus... if Mode = [] then Exit; i := 0; Randomize; While (i < ALength) do begin iM := RANDOM(4); Case iM of // Kleinbuchstaben 0: if (pmLower in Mode) then begin S := S + cLower[1+RANDOM(Length(cLower))]; Inc(i); end; // Grossbuchstaben 1: if (pmUpper in Mode) then begin S := S + cUpper[1+RANDOM(Length(cUpper))]; Inc(i); end; // Nummern 2: if (pmNumbers in Mode) then begin S := S + cNumbers[1+RANDOM(Length(cNumbers))]; Inc(i); end; // Sonderzeichen 3: if (pmExtra in Mode) then begin S := S + cExtra[1+RANDOM(Length(cExtra))]; Inc(i); end; end; end; // Generiertes Passwort zurueckgeben Result := S; end; end.
Aufruf (Beispiel)
procedure TForm1.Button1Click(Sender: TObject); var i, ii, g: integer; a: string; Password1: TPassword; begin if ((StrToInt(LabeledEdit4.Text) >= 9999) or (StrToInt(LabeledEdit1.Text) >= 999)) then begin if MessageBox(handle, PChar('Das generieren von langen bzw. vielen Passwörtern kann sich negativ auf die'+ 'Systemperformance auswirken. Wollen Sie dennoch fortfahren?'), PChar('Achtung'), MB_YESNO+MB_ICONWARNING ) = IDNO then Exit; end; Memo1.Lines.Clear; if ((LabeledEdit4.Text <> '') and (LabeledEdit1.Text <> '')) then begin ii := StrToInt(LabeledEdit1.Text); i := StrToInt(LabeledEdit4.Text); g := 1; Password1 := TPassword.Create; while g <= ii do begin a := Password1.GeneratePassword(i,[pmUpper,pmLower,pmExtra,pmNumbers]); if a <> '' then Memo1.Lines.Add(a); inc(g); end; counter := counter+ii; StatusBar1.Panels[2].Text := IntToStr(counter)+ ' generierte Passwörter'; Password1.Free; end else MessageBox(handle,Pchar('Bitte in beide Eingabefelder'+ 'die Längen eingeben!'), PChar('Error'),MB_OK+MB_ICONERROR); end;