Tips dan Trik Delphi - Tool

function Pesanku(isi:String):word;
Begin
    Application.RestoreTopMosts;
    MessageDlg(isi, mtInformation, [mbOK], 0);
    Application.RestoreTopMosts;
end;

procedure SGridToHtml(SG: TStringgrid; Dest: TMemo; BorderSize: Integer);
var 
  i, p: integer;
  SStyle1, SStyle2, Text: string;
begin
  Dest.Clear;
  Dest.Lines.Add('');
  Dest.Lines.Add('');
  Dest.Lines.Add('  ');

  for i := 0 to SG.RowCount - 1 do
  begin
    Dest.Lines.Add('  ');
    for p := 0 to SG.ColCount - 1 do
    begin
      SStyle1 := '';
      SStyle2 := '';
      if fsbold in SG.Font.Style then
      begin
        SStyle1 := SStyle1 + '';
        SStyle2 := SStyle2 + '';
      end;
      if fsitalic in SG.Font.Style then
      begin
        SStyle1 := SStyle1 + '';
        SStyle2 := SStyle2 + '';
      end;
      if fsunderline in SG.Font.Style then
      begin
        SStyle1 := SStyle1 + '';
        SStyle2 := SStyle2 + '';
      end;
      Text := sg.Cells[p, i];
      if Text = '' then Text := ' ';
      Dest.Lines.Add('    ');
    end;
    Dest.Lines.Add('  ');
  end;
  Dest.Lines.Add('  
' + SStyle1 +
        Text + SStyle2 + '
');
  Dest.Lines.Add('');;
  Dest.Lines.Add('');
end;

// Contoh penerapan
procedure TFormCSVInport.Button6Click(Sender: TObject);
begin
  SGridToHtml(StringGrid1, Memo1, 1);
  Memo1.Lines.SaveToFile('c:\test.html');
end;

function IsDate(str: string): Boolean;
var
  dt: TDateTime;
begin
  Result := True;
  try
    dt := StrToDate(str);
  except
    Result := False;
  end;
end;

function IsTime(str: string): Boolean;
var
  dt: TDateTime;
begin
  Result := True;
  try
    dt := StrToTime(str);
  except
    Result := False;
  end;
end;

function Seps(As_Arg: Char): Boolean;
begin
  Seps := As_Arg in
    [#0..#$1F, ' ', '.', ',', '?', ':', ';', '(', ')', '/', '\'];
end;

function WordCount(CText: string): Longint;
var
  Ix: Word;
  Work_Count: Longint;
begin
    Result := 0;
    Work_Count := 0;
    Ix         := 1;
    while Ix <= Length(CText) do
    begin
      while (Ix <= Length(CText)) and (Seps(CText[Ix])) do
        Inc(Ix);
      if Ix <= Length(CText) then
      begin
        Inc(Work_Count);

        while (Ix <= Length(CText)) and (not Seps(CText[Ix])) do
          Inc(Ix);
      end;
    end;
    Result := Work_Count;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     Label1.Caption := Inttostr(WordCount(Edit1.Text));
end;

function Parse(Char, S: string; Count: Integer): string;
var
  I: Integer;
  T: string;
begin
  if S[Length(S)] <> Char then
    S := S + Char;
  for I := 1 to Count do
  begin
    T := Copy(S, 0, Pos(Char, S) - 1);
    S := Copy(S, Pos(Char, S) + 1, Length(S));
  end;
  Result := T;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     Edit1.Text := (Parse('|', 'A|B|C|D|E|F', 6));
     // hasil F
end;

procedure TForm1.InsertText(str: string; Amemo: TMemo);
var
  Str1: string;
  i, ui: Integer;
begin
  ui   := Length(Amemo.Lines[Amemo.CaretPos.y]);
  str1 := Amemo.Lines[Amemo.CaretPos.y];
  if Pos('<$Cursor$>', str) > 0 then
  begin
    i   := Pos('<$Cursor$>', str);
    str := StringReplace(str, '<$Cursor$>', '', [rfReplaceAll, rfIgnoreCase]);
    i   := i - 1 + ui;
  end
  else
    i := -30;
  Insert(str, Str1, Amemo.CaretPos.x + 1);
  Amemo.Lines[Amemo.CaretPos.y] := str1;
  if i <> -30 then
  begin
    Amemo.SelStart := Amemo.Perform(EM_LINEINDEX, Amemo.CaretPos.y, 0) + i;
    Amemo.SetFocus;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
     InsertText('kursusdelphi.com',Memo1);
end;

function GetCPUVendor: string;
var
  aVendor: array [0 .. 2] of LongWord;
  iI, iJ: Integer;
begin
  asm
    push  ebx
    xor   eax, eax
    dw    $A20F // CPUID instruction
    mov   LongWord ptr aVendor, ebx
    mov   LongWord ptr aVendor[+4], edx
    mov   LongWord ptr aVendor[+8], ecx
    pop   ebx
  end;
  for iI := 0 to 2 do
    for iJ := 0 to 3 do
      Result := Result +  
        Chr((aVendor[iI] and ($000000ff shl(iJ * 8))) shr(iJ * 8));
end;

type
  TExHint = class(THintWindow)
  public
    constructor Create(AOwner: TComponent); override;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
constructor TExHint.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  with Canvas.Font do
  begin
    Name  := 'Verdana';
    Size  := Size + 15;
    Style := [fsBold, fsItalic];
  end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  HintWindowClass  := TExHint;
end;

function SetPCName(AName: string): Boolean;
var
  PCName: array[0..MAX_COMPUTERNAME_LENGTH + 1] of Char;
  Size: Cardinal;
begin
  StrPCopy(PCName, AName);
  Result := Windows.SetComputerName(PCName);
end;

procedure LogOff;
begin
     ExitWindowsEx(EWX_LOGOFF, 0);
end;