14 Juni 2017

Bismillaahirrohmanirrohim

Assalammu'alaikum wr wb
Selamat malam semua...
kali ini kita masuk ke sesi IV...
yg mana kuliah kali ini cukup singkat...
kita mulai aja...buka unit uOverride
kita timpa dengan ini
https://pastebin.com/sb3kufB1 atau
unit uOverride;

interface

uses vcl.StdCtrls, vcl.Grids, System.SysUtils, System.Classes,

System.Types, vcl.Comctrls;

type
TJSON = class
private
FObject: TTreeView;
function GetString(ATree: String): String;
procedure SetString(ATree, AStr: String);
function GetInteger(ATree: String): Integer;
procedure SetInteger(ATree: String; AInt: Integer);
function Find(TTv: TTreeNode; AText: String): TTreeNode;
public
constructor Create;
destructor Destroy; override;
function Text: String;
 property AsString[ATree: String]: String read GetString write SetString;
property AsInteger[ATree: String]: Integer read GetInteger write SetInteger;
end;

TColEditor = (ceText, ceTime);

TCombobox = class(vcl.StdCtrls.TCombobox)
private
function GetTextInt: Integer;
procedure SetTextInt(AInt: Integer);
public
property TextInt: Integer read GetTextInt write SetTextInt;
end;

TStringGrid = class(vcl.Grids.TStringGrid)
private
FFormat: TFormatSettings;
FTimeZero: boolean;
FTime: TDateTimePicker;
FJSON: TJSON;
function GetTimes(ACol, ARow: Integer): TTime;
procedure SetTimes(ACol, ARow: Integer; ATime: TTime);
function GetTimeText(ACol, ARow: Integer): String;
function GetColEditor(ACol: Integer): TColEditor;
procedure SetColEditor(ACol: Integer; AEditor: TColEditor);
procedure InvisibleEditor;
procedure TimeChange(Sender: TObject);
protected
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure Click; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ConfigText: String;
property Times[ACol, ARow: Integer]: TTime read GetTimes write SetTimes;
property FormatSettings: TFormatSettings read FFormat;
property TimeText[ACol, ARow: Integer]: String read GetTimeText;
property TimeZero: Boolean read FTimeZero write FTimeZero;
property ColEditor[ACol: Integer]: TColEditor read GetColEditor
write SetColEditor;
end;

implementation

uses Vcl.Forms, System.Variants;

{TJSON}
constructor TJSON.Create;
begin
inherited Create;
FObject := TTreeview.Create(nil);
FObject.Parent := TForm.Create(nil);
FObject.Items.AddChild(nil, 'root');
end;

destructor TJSON.Destroy;
begin
TForm(FObject.Parent).Free;
inherited Destroy;
end;

function TJSON.GetInteger(ATree: String): Integer;

begin
result := StrToIntDef(GetString(ATree), 0);
end;

procedure TJSON.SetInteger(ATree: String; AInt: Integer);

begin
SetString(ATree, IntToStr(AInt));
end;

function TJSON.Find(TTv: TTreeNode; AText: String): TTreeNode;

var
iii: Integer;
begin
result := nil;

for iii := 0 to TTv.Count - 1 do

begin
if TTv.Item[iii].Text = AText then
begin
result := TTv.Item[iii];
exit;
end;
end;
end;

function TJSON.GetString(ATree: String): String;

var
lst: TStrings;
 iii: Integer;
tv1: TTreeNode;
tv2: TTreeNode;
begin
lst := TStringList.Create;
tv1 := FObject.Items[0];
lst.Text := StringReplace(ATree, '/', #13#10, [rfReplaceAll]);

for iii := 0 to lst.Count - 1 do

begin
tv2 := Find(tv1, lst[iii]);
if tv2 = nil then
begin
result := '';
exit;
end;

tv1 := tv2;
end;

if tv1.Count = 0 then
result := '' else
result := tv1.Item[0].Text;
end;

function TJSON.Text: String;

begin
result := '';
end;

procedure TJSON.SetString(ATree, AStr: String);

var
lst: TStrings;
iii: Integer;
tv1: TTreeNode;
tv2: TTreeNode;
begin
lst := TStringList.Create;
tv1 := FObject.Items[0];
lst.Text := StringReplace(ATree, '/', #13#10, [rfReplaceAll]);

for iii := 0 to lst.Count - 1 do

begin
tv2 := Find(tv1, lst[iii]);
if tv2 = nil then
 tv1 := FObject.Items.AddChild(tv1, lst[iii]) else
tv1 := tv2;
end;

if tv1.Count = 0 then
FObject.Items.AddChild(tv1, AStr) else
tv1.Item[0].Text := AStr;
end;

{TStringGrid}
procedure TStringGrid.TimeChange(Sender: TObject);
begin
SetTimes(Col, Row, FTime.Time);
end;

procedure TStringGrid.Click;
var
Rec: TRect;
Tim: TTime;
begin
if GetColEditor(Col) = ceTime then
begin
if (Col < FixedCols) or (Row < FixedRows) then exit;

Rec := CellRect(Col, Row);

Tim := StrToTimeDef(Cells[Col, Row], 0, FFormat);

FTime.Time := Tim;
FTime.Left := Rec.Left + 2;
FTime.Top := Rec.Top + 2;
FTime.Visible := true;
FTime.Kind := dtkTime;
FTime.Format := FFormat.LongTimeFormat;
FTime.Width := ColWidths[Col] - 4;
end;
end;

function TStringGrid.ConfigText: String;

begin
result := FJSON.Text;
end;

procedure TStringGrid.InvisibleEditor;
begin
FTime.Visible := false;
end;

function TStringGrid.GetColEditor(ACol: Integer): TColEditor;

var
sss: String;
begin
sss := format('editor/col/%d', [ACol]);
result := TColEditor(FJSON.GetInteger(sss));
end;

procedure TStringGrid.SetColEditor(ACol: Integer; AEditor: TColEditor);

var
sss: String;
begin
sss := format('editor/col/%d', [ACol]);

FJSON.SetString(sss, VarToStr(AEditor));
end;

destructor TStringGrid.Destroy;
begin
FTime.Free;
FJSON.Free;

inherited Destroy;
end;

procedure TStringGrid.MouseMove(Shift: TShiftState; X, Y: Integer);

begin
inherited MouseMove(Shift, X, Y);
InvisibleEditor;

if Assigned(OnMouseMove) then
OnMouseMove(Self, Shift, X, Y);
end;

function TStringGrid.GetTimeText(ACol, ARow: Integer): String;

begin
result := TimeToStr(GetTimes(ACol, ARow), FFormat);
end;

constructor TStringGrid.Create(AOwner: TComponent);

begin
inherited Create(AOwner);
FTime := TDateTimePicker.Create(Self);
 FTime.Parent := Self;
FTime.Visible := false;
FTime.OnChange := TimeChange;
FJSON := TJSON.Create;

FFormat.LongTimeFormat := 'HH:mm:ss';
FFormat.ShortTimeFormat := 'HH:mm:ss';
FFormat.TimeSeparator := ':';
end;

function TStringGrid.GetTimes(ACol, ARow: Integer): TTime;

begin
result := StrToTimeDef(Cells[ACol, ARow], 0, FFormat);
end;

procedure TStringGrid.SetTimes(ACol, ARow: Integer; ATime: TTime);

begin
if (ATime = 0) and (not FTimeZero) then
Cells[ACol, ARow] := '' else
Cells[ACol, ARow] := TimeToStr(ATime, FFormat);
end;

{TCombobox}
function TCombobox.GetTextInt: Integer;
begin
result := StrToIntDef(Text, 0);
end;

procedure TCombobox.SetTextInt(AInt: Integer);

begin
ItemIndex := Items.IndexOf(IntToStr(AInt));
end;

end.

Coba di run..
datetimepicker dtJam kita hapus
sudah dihapus? terus di run

jikaerror
semua procedure yg ada dtJam nya kita hapus
procedure TfrmUtama.dtJamChange(Sender: TObject); hapus
procedure TfrmUtama.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer); hapus
procedure TfrmUtama.gridClick(Sender: TObject); hapus
procedure yang terisisa

Pasti tidak muncul jika di klik cellnya

nah skrg di cbBulanChange kita tambahkan 2 baris

Lalu di run..
nah...di STringGrid gak ada lagi koding tampilan (UI)
tinggal dikembangkan dan bisa digunakan di project mana pun...tinggal panggil unit nya di uses
cukup sekian kulgram singkat ini...
Terima kasih atas perhatiannya semua....
selamat malam
wassalamu’alaikum wr wb