Delphi Snippets [NoSociety.de]

Diese Seite ist nicht editierbar. Sie können den Quelltext sehen, jedoch nicht verändern. Kontaktieren Sie den Administrator, wenn Sie glauben, dass hier ein Fehler vorliegt.
====== Delphi Snippets ======

===== Balloon Tipps anzeigen =====

<code delphi>
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;
</code>

===== Dateinamen mit Zufallszahlen =====

<code delphi>
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;
</code>

===== SQLite Wrapper =====

<code delphi>
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;
</code>

===== Random Passwort Klasse =====

<code delphi>
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.
</code>

==== Aufruf (Beispiel) ====

<code delphi>
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;
</code>