ایجاد tile در devexpress کامپوننت دلفی

  و  ایجاد کاشی در زمان اجرا devexpress کامپوننت دلفی 

و ایجاد کد رنگ رندوم

procedure TDesktopDemoMainForm.Button1Click(Sender: TObject);

var AItem: TdxTileControlItem;

    sizeItem:integer;

begin

   AItem:= dxTileControl1.items.add;

   with AItem do

   begin

     IsLarge := True;

     AItem.Name:='a'+inttostr(random(4000));

     AItem.Text1.value:='test';

     sizeItem:=random(4)  ;

     case  sizeItem   of

   //  1:AItem.Size:=tcisSmall;

     1:AItem.Size:=tcisLarge;

     2:AItem.Size:=tcisRegular;

     3:AItem.Size:=tcisLarge;

     4: AItem.Size:=tcisExtraLarge;

     end;

     text1.font.Size:=12;

     glyph.ImageIndex:=random(9)  ;

     group:=dxTileControl1Group1;

     style.GradientBeginColor:=GenerateRandomColor;

   end;

end;

function GenerateRandomColor(const Mix: TColor = clWhite): TColor;
var
  Red, Green, Blue: Integer;
begin
  Red := Random(256);      
  Green := Random(256);
  Blue := Random(256);

  Red := (Red + GetRValue(ColorToRGB(Mix))) div 2;      
  Green := (Green + GetGValue(ColorToRGB(Mix))) div 2;
  Blue := (Blue + GetBValue(ColorToRGB(Mix))) div 2;
  Result := RGB(Red, Green, Blue);
end;

Delphi/Lazarus: Round Decimal Numbers up, down and normally

• Round: normal, convergent rounding (Banker's Rule)
• Trunc: crops decimal places (=rounding down)
• Ceil: rounding up (contained in Math)
• Floor: rounding down (contained in Math)
• Int: makes an integer value from a decimal number (=rounding down)
• Frac: crops all before the decimal places/replaces the integer part of the number with 0

Delphi custom TTreeNode

برای داشتن ایتم های اضافی در درخت دلفی  میتوان با نوشتن کد زیر ان را شخصی سازی کرد 

type
  TCustomTreeNode = class(TTreeNode)
  protected
    procedure Assign(Source: TPersistent); override;
  public
    Comment: string;
  end;

procedure TCustomTreeNode.Assign(Source: TPersistent);
begin
  if Source is TCustomTreeNode then
    Comment := TCustomTreeNode(Source).Comment;
  inherited;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
  NewNode: TCustomTreeNode;
begin
  NewNode := TreeView1.Items.Add(nil, 'Node1') as TCustomTreeNode;
  NewNode.Comment := 'A comment';
  NewNode := TreeView1.Items.Add(nil, 'Node2') as TCustomTreeNode;
  NewNode.Comment := 'Another comment';
end;

procedure TForm1.TreeView1Click(Sender: TObject);
var
  Node: TCustomTreeNode;
begin
  Node := TreeView1.Selected as TCustomTreeNode;
  if Assigned(Node) then
    ShowMessage(Node.Comment);
end;

procedure TForm1.TreeView1CreateNodeClass(Sender: TCustomTreeView; var NodeClass: TTreeNodeClass);
begin
  NodeClass := TCustomTreeNode;
end;

کم کردن حجم خروجی فایل exe دلفی

کم کردن حجم  خروجی فایل exe دلفی در ورژن های دلفی بالا xe 5 :
Project-->Option-->Delphi Compiler-->Linking-->Debug Information
این تیک اگر true هست false کنید بعد کامپایل بگیرید حجم برنامه تقریبا نصف میشه
این تیک چیز مهمی نیست فقط راهنماهای دلفی درون برنامه میگذاره که تاثیری در برنامه نداره

پارس کردن ارایه جیسون در دلفی

برای پارس کردن ارایه در دلفی که نام ندارد از روش زیر میشود استفاده کرد 

program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
  System.SysUtils, dbxjson;
const JSON_DATA = '{"ArrayData":['+
                    '{"DAT_INCL":"07/03/2012 17:33:03", "NUM_ORDE":1,"NUM_ATND":1, "NUM_ACAO":2, "NUM_RESU":3},'+
                    '{"DAT_INCL":"07/03/2012 17:33:05", "NUM_ORDE":2,"NUM_ATND":1, "NUM_ACAO":4, "NUM_RESU":5},'+
                    '{"DAT_INCL":"07/03/2012 17:33:05", "NUM_ORDE":3,"NUM_ATND":1, "NUM_ACAO":8, "NUM_RESU":null}'+
                   ']}';
var jsv   : TJsonValue;
    originalObject : TJsonObject;
    jsPair : TJsonPair;
    jsArr : TJsonArray;
    jso  : TJsonObject;
    i : integer;
begin
    try
        //parse json string
        jsv := TJSONObject.ParseJSONValue(JSON_DATA);
        try
            //value as object
            originalObject := jsv as TJsonObject;
            //get pair, wich contains Array of objects
            jspair := originalObject.Get('ArrayData');
            //pair value as array
            jsArr := jsPair.jsonValue as  TJsonArray;
            writeln('array size: ', jsArr.Size);
            //enumerate objects in array
            for i := 0 to jsArr.Size - 1 do begin
                writeln('element ', i);
                // i-th object
                jso := jsArr.Get(i) as TJsonObject;
                //enumerate object fields
                for jsPair in jso do begin
                    writeln('   ', jsPair.JsonString.Value, ': ', jsPair.JsonValue.Value);
                end;
            end;
        finally
            jsv.Free();
            readln;
        end;
    except
        on E: Exception do
          Writeln(E.ClassName, ': ', E.Message);
    end;
end.

استفاده از messageBox به جای messageDlg در دلفی

استفاده از messageBox به جای messageDlg در دلفی این امکان را میدهد که تعیین نمایید کدام دکمه فعال باشد . به عنوان مثال برای فعال بودن دکمه no از کد زیر استفاده میکنیم

if MessageBox(0, 'Message...', 'MessageBox caption', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_TASKMODAL) = IDYES then

عدم تغییر رنگ یک کنترل خاص بعد از دادن استایل دلفی

  بعد از دادن استایل در دلفی ، تمام کنترل ها به رنگ و تم انتخابی تغییر میکنند  . برای اینکه یکسری از کنترل ها رو رنگ دلخواه بگذارید از تابع زیر استفاده کنید

procedure DisableVclStyles(Control : TControl;const ClassToIgnore:string);
var
  i : Integer;
begin
  if Control=nil then
    Exit;
   Control.StyleElements:=[];
  if not Control.ClassNameIs(ClassToIgnore) then
  if Control is TWinControl then
      DisableVclStyles(TWinControl(Control).Controls[i], ClassToIgnore);
    for i := 0 to TWinControl(Control).ControlCount-1 do
end;

برای فراخوانی نیز از کد زیر استفاده نمایید

DisableVclStyles(Self,'TButton');

تغییر scroll پنل در زمان runtime

در صورت ایجاد ابجکت ها در زمان اجرا در داخل اسکرول باکس پرش به وجود می اید میتوان با گذاشتن یک پنل و یک اسکرول بار روی فرم و نوشتن کد زیر برای اسکرول این کار را شبیه سازی نمایید . همچنین یک متغیر ایکس سراسری تعریف و در زمان ایجاد فرم برابر با صفر گذاشته شود . 

procedure TForm1.ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;

  var ScrollPos: Integer);

begin

  if ScrollPos>x then

    Panel1.ScrollBy(0, -ScrollPos);

  if ScrollPos<x then

    Panel1.ScrollBy(0, ScrollPos);

  panel1.repaint;

  x:=ScrollPos;

end;

رفع خطا زمان دیباگ در دلفی 7

اگر در زمان کامپایل با این خطا مواجه شدید project raised exception class eoleexception with message  مراحل زیر را دنبال کنید :

Tools > Debugger Options > Language Exceptions و بعد گزینه add  را بزنید "EOleException" را اضافه نمایید

فیلترگذاری بر روی dbgrideh دلفی

برای فیلتر گذاری روی dbgrideh کافی تنظیمات زیر انجام بدید 

uses   EhLibMTE;
MemTableEh1.Filtered:=true;
DBGridEh1.STFilter.Local:=true;
DBGridEh1.STFilter.InstantApply:=true;
DBGridEh1.STFilter.Visible:=true;

مرتب سازی dbgrideh در دلفی

نحوه مرتب سازی dbgrideh در دلفی

procedure TForm1.DBGridEh1TitleBtnClick(Sender: TObject; ACol: Integer;
  Column: TColumnEh);
  var i,j:Integer;
  sort_str: String;
begin
  for j:=0 to Column.Grid.Columns.Count-1 do
    if (Column.Grid.Columns[j].Title.SortMarker <> smNoneEh) and (Column.Grid.Columns[j]<>Column)
      then Column.Grid.Columns[j].Title.SortMarker := smNoneEh;
  case Column.Title.SortMarker of
    smNoneEh: Column.Title.SortMarker := smDownEh;
    smDownEh: Column.Title.SortMarker := smUpEh;
  end;
    smUpEh: Column.Title.SortMarker := smNoneEh;

case Column.Title.SortMarker of
smUpEh :TAdoDataset(DbgridEh1.DataSource.DataSet).Sort := Column.FieldName+' ASC';
smDownEh :TAdoDataset(DbgridEh1.DataSource.DataSet).Sort := Column.FieldName+' DESC';
smNoneEh :TAdoDataset(DbgridEh1.DataSource.DataSet).Sort := '';
end;
end

و یا  تنظیمات زیر

uses  ehlibADO;
dbGrideh1.OptionsEh.dghAutoSortMarking:=true;

نمایش ای پی سیستم در دلفی

 نمایش ای پی سیستم در دلفی

uses winsock;

{$R *.dfm}

function LocalIP: string;

type

TaPInAddr = array [0..10] of PInAddr;

PaPInAddr = ^TaPInAddr;

var

phe: PHostEnt;

pptr: PaPInAddr;

Buffer: array [0..63] of Ansichar;

i: Integer;

GInitData: TWSADATA;

begin

WSAStartup($101, GInitData);

Result := '';

GetHostName(Buffer, SizeOf(Buffer));

phe := GetHostByName(Buffer);

if phe = nil then

Exit;

pptr := PaPInAddr(phe^.h_addr_list);

i := 0;

while pptr^[i] <> nil do

begin

Result := StrPas(inet_ntoa(pptr^[i]^));

Inc(i);

end;

WSACleanup;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(LocalIP);

end;

نصب کامپوننت socket در دلفی

The socket components are not installed by default. To use the socket components, you must install the dclsockets<.bpl> package.

To install the socket components:

1. Select Component > Install Packages.
2. In the Install Packages dialog box, click Add.
3. In the Add Design Package dialog, browse to C:\Program Files (x86)\Embarcadero\Studio\19.0\bin.
4. Select dclsockets250.bpl, and click Open.
5. Click OK to dismiss Install Packages dialog.
6. The socket components (TClientSocket and TServerSocket) are listed in the Internet category of the Toot Palette.

نمایش عکس از روی url در دلفی

برای نمایش عکس از روی url کد زیر استفاده می نماییم 

procedure TForm1.Button1Click(Sender: TObject);
var
    MS : TMemoryStream;
begin
   MS := TMemoryStream.Create;
   try
         IdHTTP1.get('http://image1.jpg',MS);
         ms.Position:=0;
         Image1.Picture.LoadFromStream(MS);
  finally
    FreeAndNil(MS);
  end;
end;

نمایش ارایه جیسون در دلفی

نمایش ارایه جیسون در دلفی

uses
  DBXJSON,
  System.SysUtils;
Const
StrJson =
  '['+
  '{"EventType":49,"Code":"234","EventDate":"20050202", "Result":1},'+
  '{"EventType":48,"Code":"0120","EventDate":"20130201", "Group":"g1"}'+
  ']';
procedure ParseJson;
var
  LJsonArr   : TJSONArray;
  LJsonValue : TJSONValue;
  LItem     : TJSONValue;
begin
   LJsonArr    := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(StrJson),0) as TJSONArray;
   for LJsonValue in LJsonArr do
   begin
      for LItem in TJSONArray(LJsonValue) do
        Writeln(Format('%s : %s',[TJSONPair(LItem).JsonString.Value,
        TJSONPair(LItem).JsonValue.Value]));
     Writeln;
   end;
end;
begin
  try
    ParseJson;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.